SB_Fileset> Start>QBC675.sb< TextWindow.Write("please enter the diameter in pixels of your first ring: ") di=textwindow.ReadNumber() TextWindow.Write("please enter the distance between the rings of your target: ") rin= TextWindow.ReadNumber() TextWindow.Write("how many rings would you like your target to have: ") num=textwindow.ReadNumber() TextWindow.Hide() 'transition to graphics window GraphicsWindow.Width=800 GraphicsWindow.Height=600 For i=0 To num GraphicsWindow.DrawEllipse(400-(di+rin*i/2),300-(di+rin*i/2),di+(rin*i),di+(rin*i)) EndFor 'also good for optical illusions End>QBC675.sb< Start>QBC688.sb< ' The following line could be harmful and has been automatically commented. ' ff=File.ReadContents ("j:\vb12pub\paint11r.sb") nn=text.GetCharacter(34) ff= LDText.Replace (ff,"`","="+nn) ff= LDText.Replace (ff,"#ei","Elseif") ff= LDText.Replace (ff,">>"," Then") ff= LDText.Replace (ff,"&&"," And ") ff= LDText.Replace (ff,"&$","and") ff= LDText.Replace (ff,"$r","Math.Round") ff= LDText.Replace (ff,"#rnd","Math.Getrandomnumber") 'ff= LDText.Replace (ff,"}","])") ff= LDText.Replace (ff,"~",nn+")") ff= LDText.Replace (ff,"||"," Else") ff= LDText.Replace (ff,"|>"," For ") ff= LDText.Replace (ff,"#ef"," EndFor ") ff= LDText.Replace (ff,"<<",nn+" Then") ff= LDText.Replace (ff,"!!(","Shapes.addrectangle(") ff= LDText.Replace (ff,"!!","If ") ff= LDText.Replace (ff,"!es","Endsub") ff= LDText.Replace (ff,"sh#^^","Shapes.move(") ff= LDText.Replace (ff,"sh#hh","Shapes.hideshape") ff= LDText.Replace (ff,"sh#rm","Shapes.remove") ff= LDText.Replace (ff,"sh#ss","Shapes.showshape") ff= LDText.Replace (ff,"sh#tx","Shapes.settext") ff= LDText.Replace (ff,"sh#op","Shapes.SetOpacity") ff= LDText.Replace (ff,"_lbd","Mouse.IsLeftButtonDown") ff= LDText.Replace (ff,"_rbd","Mouse.IsrightButtonDown") ff= LDText.Replace (ff,"sh#","Shapes.") ff= LDText.Replace (ff,"cc#sz","controls.setsize") ff= LDText.Replace (ff,"cc#","controls.") ff= LDText.Replace (ff,"il#pr","ImageList.LoadImage(PathResources+") bb=LDControls.AddRichTextBox(1000,900) GraphicsWindow.Width =1000 GraphicsWindow.Height =900 fl= LDText.Split (ff, ESLText.CRLF) ac=Array.GetItemCount (fl) LDControls.RichTextBoxFontFamily="Segoe" LDControls.RichTextBoxFontSize=11 LDControls.RichTextBoxDefault (bb) For x=1 To ac If Text.StartsWith (fl[x],"}#") Then w=text.GetSubTextToEnd (fl[x],3) If w<1 or w="" then w=1 endif For r=1 To w ttx=ttx+"Endif"+ESLText.CRLF EndFor Goto tt elseIf Text.StartsWith (ldtext.Trim (fl[x]),"gw#") Then dt="" If Text.IsSubText (fl[x],"#fe") then dd="fillellipse dt="fe elseIf Text.IsSubText (fl[x],"#fr") then dd="fillrectangle dt="fr elseIf Text.IsSubText (fl[x],"#bc") then dd="brushcolor dt="bc Else dd="" endif fl[x]= LDText.Replace (fl[x],"gw#"+dt," GraphicsWindow."+dd) GraphicsWindow.Title=x elseif Text.EndsWith (fl[x],"}") then fl[x]=Text.GetSubText(fl[x],1,text.GetLength (fl[x])-1)+"])" EndIf fl[x]= LDText.Replace (fl[x],"gw#","GraphicsWindow.") ttx=ttx+fl[x]+ESLText.CRLF tt: EndFor LDControls.RichTextBoxSetText (bb,ttx,"false") End>QBC688.sb< Start>QBD569.sb< GraphicsWindow.Title = "Text Challenge 2 - November 2012 (Graphic Version with Button)" GraphicsWindow.Width = 728 GraphicsWindow.Height = 500 GraphicsWindow.Top = 0 GraphicsWindow.Left = 0 GraphicsWindow.CanResize = "False" GraphicsWindow.BackgroundColor = "OrangeRed" GraphicsWindow.BrushColor = "Black" Resp = Controls.AddTextBox(189, 20) Controls.SetSize(Resp, 300, 25) GraphicsWindow.BrushColor = "Red" Enter = Controls.AddButton("Enter", 489, 20) Controls.SetSize(Enter, 50, 25) GraphicsWindow.BrushColor = "White" GraphicsWindow.DrawText(50, 1, "Use the provided text box to type in your answers then click the 'Enter' button to save and clear the box.") GraphicsWindow.DrawText(0, 45, "Questions Appear Here:") GraphicsWindow.DrawText(670, 498, "Version 1.5") GraphicsWindow.DrawText(430, 45, "You Answered:") GraphicsWindow.DrawText(0, 47, "________________________________________________________________________________________________") GraphicsWindow.DrawText(0, 432, "________________________________________________________________________________________________") GraphicsWindow.DrawText(0, 446, "**For your info, questions are not the same as in previous versions!**") GraphicsWindow.DrawText(0, 460, "**Grammar may appear inadequate due to user responses.**") GraphicsWindow.DrawText(0, 482, "Questions/visuals (C) Joman Mied. Source Code (C) NaochanON. Idea for challenge (C) LitDev &/Or respective owners.") ' 7 second delay so the user can read what's been put up on the screen (Instructions, Copyrights) Program.Delay(7000) Controls.ButtonClicked = OnButtonClick question=1 Do_question() Sub Do_question If question =1 Then GraphicsWindow.DrawText(0, 60, "1. Welcome, What is your name?") Sound.PlayClick() ElseIf Question= 2 then GraphicsWindow.DrawText(430, 60, UserAns[1]) GraphicsWindow.DrawText(0, 80, "2. Hello, " + UserAns[1] + "! How are you? [Great, Good, or Bad]") Sound.PlayClick() elseif Question= 3 then If UserAns[2] = "great" Or UserAns[2] = "Great" Then GraphicsWindow.DrawText(0, 100, "3. That's awesome to hear!") ElseIf UserAns[2] = "good" Or UserAns[2] = "Good" Then GraphicsWindow.DrawText(0,100, "3. That's good to hear!") ElseIf UserAns[2] = "bad" Or UserAns[2] = "Bad" Then GraphicsWindow.DrawText(0,100, "3. I am sorry to hear that!") Else GraphicsWindow.DrawText(0,100, "3. Sorry! I don't follow?") EndIf GraphicsWindow.DrawText(430, 80, UserAns [2]) GraphicsWindow.DrawText(175, 100, "What is your hobby, " + UserAns[1] + "?") Sound.PlayClick() elseif question = 4 Then GraphicsWindow.DrawText(430, 100, UserAns[3]) GraphicsWindow.DrawText(0, 120, "4. What city do you live in?") Sound.PlayClick() ElseIf question = 5 Then GraphicsWindow.DrawText(430, 120, UserAns[4]) GraphicsWindow.DrawText(0, 140, "5. Cool! Besides " + UserAns[3] + ", ") GraphicsWindow.DrawText(1, 152, "what is your favourite thing to do?") Sound.PlayClick() ElseIf question = 6 Then GraphicsWindow.DrawText(430, 145, UserAns[5]) GraphicsWindow.DrawText(0, 170, "6. In what time zone is " + UserAns[4] + "?") Sound.PlayClick() ElseIf question = 7 Then GraphicsWindow.DrawText(430, 170, UserAns[6]) GraphicsWindow.DrawText(0, 190, "7. Mac or Windows?") Sound.PlayClick() ElseIf question = 8 Then GraphicsWindow.DrawText(430, 190, UserAns[7]) If UserAns[7] = "Mac" Or UserAns[7] = "mac" Then GraphicsWindow.DrawText(150, 190, "Get a real computer!") ElseIf UserAns[7] = "Windows" Or UserAns[7] = "windows" Then GraphicsWindow.DrawText(150, 190, "I am so proud of you!") EndIf GraphicsWindow.DrawText(0, 210, "8. Out of [Small Basic, Visual Basic, C#, C++, or None],") GraphicsWindow.DrawText(1, 222, "which do you know best?") Sound.PlayClick() ElseIf question = 9 Then GraphicsWindow.DrawText(430, 215, UserAns[8]) If UserAns[8] = "None" or UserAns[8] = "none" then GraphicsWindow.DrawText(0, 240, "9. How many siblings do you have?") GraphicsWindow.DrawText(1, 252, "[# = # upto 9 where it's = to 9 or more]") Else GraphicsWindow.DrawText(0, 240, "9. You said you program in " + UserAns[8] + ",") GraphicsWindow.DrawText(1, 252, "How difficult is it for you? [Easy, Medium, Hard]") EndIf Sound.PlayClick() ElseIf question = 10 Then GraphicsWindow.DrawText(430, 245, UserAns[9]) If UserAns[9] = "easy" Or UserAns[9] = "Easy" Then GraphicsWindow.DrawText(300, 245, "You're a pro!") ElseIf UserAns[9] = "Medium" or UserAns[9] = "medium" then GraphicsWindow.DrawText(300, 245, "Right on!") ElseIf UserAns[9] = "Hard" or UserAns[9] = "hard" Then GraphicsWindow.DrawText(300, 245, "It'll get easier!") ElseIf UserAns[9] = "1" Or UserAns[9] = "2" Or UserAns[9] = "3" Or UserAns[9] = "4" Or UserAns[9] = "5" Or UserAns[9] = "6" Or UserAns[9] = "7" Or UserAns[9] = "8" Or UserAns[9] = "9" Then GraphicsWindow.DrawText(250, 245, "You have " + UserAns[9] + " sibling(s)? Cool.") EndIf GraphicsWindow.DrawText(0, 270, "10. Do you want your summary? [Yes, No]") Sound.PlayClick() ElseIf question = 11 Then GraphicsWindow.DrawText(430, 270, UserAns[10]) Sound.PlayClick() If UserAns[8] = "None" Or UserAns[8] = "none" then UserAns[8] = "does not program." Else UserAns[8] = "programs in " + UserAns[8] EndIf If UserAns[10] = "Yes" Or UserAns[10] = "yes" then GraphicsWindow.DrawText(10, 310, UserAns[1] + " feels " +UserAns[2]+". " + UserAns[1] +"'s hobby is " +UserAns[3]+".") GraphicsWindow.DrawText(10, 332, UserAns[1] + " lives in " + UserAns[4] + " and enjoys " + UserAns[5] + ".") GraphicsWindow.DrawText(10, 354, UserAns[4] + " is in the " + UserAns[6] + " time zone.") GraphicsWindow.DrawText(10, 376, UserAns[1] + " likes " + UserAns[7] + " and " + UserAns[8]) GraphicsWindow.DrawText(100, 400, "****The End!****") ElseIf UserAns[10] = "no" Or UserAns[10] = "No" Then EndIf endif endsub Sub OnButtonClick UserAns[question] = Controls.GetTextBoxText(Resp) Controls.SetTextBoxText(Resp, "") question = question+1 Do_question() EndSub End>QBD569.sb< Start>QBF266.sb< '------------------------------------------------------------ Restart : GraphicsWindow.Clear() '------------------------------------------------------------ '------------------------------------------------------------ GraphicsWindow.Width = 1010 GraphicsWindow.Height = 300 GraphicsWindow.Left =(Desktop.Width / 2) - (GraphicsWindow.Width / 2) GraphicsWindow.Top =(Desktop.Height / 2) - (GraphicsWindow.Height / 2) GraphicsWindow.CanResize = "False" GraphicsWindow.BackgroundColor = "black" GraphicsWindow.FontName = "DS-Digital" '------------------------------------------------------------ '------------------------------------------------------------ Std() strt=0 GraphicsWindow.FontSize = 70 GraphicsWindow.DrawText(10,20,"ENTREZ LES PARAMETRES HORAIRES") GraphicsWindow.FontSize = 40 GraphicsWindow.DrawText(300,120,"H:") GraphicsWindow.DrawText(450,120,"M:") GraphicsWindow.DrawText(600,120,"S:") BX1=Controls.AddTextBox(330,115) Controls.SetSize(BX1,60,50) BX2=Controls.AddTextBox(480,115) Controls.SetSize(BX2,60,50) BX3=Controls.AddTextBox(630,115) Controls.SetSize(BX3,60,50) GraphicsWindow.FontSize = 25 B01=Controls.AddButton("LANCER LE DECOMPTE",120,220) B02=Controls.AddButton("CHRONO FREE RUN",430,220) B03=Controls.AddButton("CHRONO NORMAL",700,220) Controls.ButtonClicked=Btn While strt=0 endwhile '------------------------------------------------------------ '------------------------------------------------------------ 'DEROULEMENT HORAIRE deltah=Controls.GetTextBoxText(BX1) deltam=Controls.GetTextBoxText(BX2) deltas=Controls.GetTextBoxText(BX3) GraphicsWindow.Clear() If strt=1 then ''DECOMPTE B1=Controls.AddButton("PAUSE",20,10) B9=Controls.AddButton("REMISE A ZERO",120,10) '------------------------------------------------------------------------ 'RETOUR MENU Brestart=Controls.AddButton("RETOUR MENU",20,250) '------------------------------------------------------------------------ GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "blue" GraphicsWindow.DrawText(400,10,"D E C O M P T E") elseif strt=2 then ''FREE RUN GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "blue" GraphicsWindow.DrawText(350,10,"CHRONO FREE RUN") '------------------------------------------------------------------------ 'RETOUR MENU GraphicsWindow.FontSize = 25 GraphicsWindow.BrushColor = "GREEN" Brestart=Controls.AddButton("RETOUR MENU",20,250) '------------------------------------------------------------------------ deltah=deltah-Clock.Hour If deltah<0 then deltah=deltah+24 endif deltam=deltam-Clock.Minute If deltah=0 and deltam<0 then deltah=deltah+23 deltam=deltam+60 endif deltas=deltas-Clock.Second strt=1 elseif strt=-1 then ''timer '------------------------------------------------------------ '------------------------------------------------------------ 'CHRONO NORMAL 'GraphicsWindow.Title = " CHRONO" '------------------------------------------------------------------------ 'RETOUR MENU Brestart=Controls.AddButton("RETOUR MENU",20,250) '------------------------------------------------------------------------ GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "blue" GraphicsWindow.DrawText(450,10,"C H R O N O") GraphicsWindow.FontSize = 25 GraphicsWindow.BrushColor = "green" B1=Controls.AddButton("PAUSE",20,10) B9=Controls.AddButton("REMISE A ZERO",120,10) endif GraphicsWindow.FontSize = 25 GraphicsWindow.BrushColor = "red" Bexit=Controls.AddButton("QUITTER",905,10) Big() deltat=3600*deltah+60*deltam+deltas update() Timer.Interval=1000 Timer.Tick=update '------------------------------------------------------------ '------------------------------------------------------------ 'ROUTINE BOUTONS Sub Btn If Controls.LastClickedButton=B01 Then strt=1 ElseIf Controls.LastClickedButton=B02 then strt=2 ElseIf Controls.LastClickedButton=B03 then strt=-1 elseif controls.LastClickedButton=B1 Then Timer.Pause() Std() GraphicsWindow.FontSize = 25 B2= Controls.AddButton("REPRISE",20,60) ElseIf Controls.LastClickedButton=B2 then Timer.Resume() Std() GraphicsWindow.FontSize = 25 B1=controls.AddButton("PAUSE",20,10) Big() elseif Controls.LastClickedButton=B9 then deltat=3600*deltah+60*deltam+deltas+strt Big() update() '------------------------------------------------------------ '------------------------------------------------------------ 'BOUTON RETOUR MENU ElseIf Controls.LastClickedButton=Brestart Then timer.Pause() strt=99 '------------------------------------------------------------ elseif Controls.LastClickedButton=Bexit then Program.End() endif Timer.Tick=Update EndSub '------------------------------------------------------------ Sub update 'GraphicsWindow.FontSize = 40 'GraphicsWindow.BrushColor = "blue" 'GraphicsWindow.DrawText(450,10,"C H R O N O FREE RUN") GraphicsWindow.FontSize = 200 GraphicsWindow.BrushColor = "green" GraphicsWindow.BrushColor="Black" GraphicsWindow.FillRectangle(20,50,960,200) GraphicsWindow.BrushColor="Red" deltat=deltat-strt If deltat>=0 then h="x "+math.Floor(deltat/3600) h=text.GetSubTextToEnd(h,text.GetLength(h)-1) m=Text.GetSubTextToEnd(100+Math.Floor(deltat/60)-60*h,2) s= Text.GetSubTextToEnd(100+deltat-3600*h-60*m,2) GraphicsWindow.DrawText (150,80, h+":"+m+":"+s) Else ala=0 Timer.Tick=Alarm endif EndSub Sub Big '' set big red characters GraphicsWindow.BrushColor = "red" GraphicsWindow.FontSize = 200 EndSub Sub Std '' set standard characters GraphicsWindow.BrushColor = "Green" GraphicsWindow.FontSize = 15 EndSub '------------------------------------------------------------ While strt<10 GraphicsWindow.Width = 1010 GraphicsWindow.Height = 300 endwhile Goto restart '------------------------------------------------------------ '------------------------------------------------------------ Sub Alarm If Ala=0 Then ala=1 GraphicsWindow.DrawText(15,30,"ALARME") Sound.PlayMusic("C8 F4 C8") Else ala=0 GraphicsWindow.BrushColor="Black" GraphicsWindow.FillRectangle(20,10,960,200) GraphicsWindow.BrushColor="Red" EndIf EndSub '------------------------------------------------------------ End>QBF266.sb< Start>QBF381.sb< cc[1]="..###.. #### . ### . ### .#####. ##### .#####. ### .# # ### # # # #### ### ##### ##### # # # # # # # .####...####...# # .# #. # #. # # cc[2]=".# #. # # .# #. # # .# . # . # . # # .# # # # # # # # # # # # . # ## # ## ## # # .# #..# #..# # .# # # # # # cc[3]=".# #. #### .# . # # .#### . #### . # . # # .# # # ##### # ### # # # # . # # # # # # # ## .# #..# #..# # .# # # # cc[4]=".#####. # # .# . # # .# . # . # . # # .# # # ## # # # # # # # # # # . # # ## # # # # .#### ..#### ..# # .# # # # cc[5]=".# #. # # .# #. # # .# . # . # . # # .# # # # # # # # # # # ## # # . # # # # # # # .# ..# # .. # # .# # # # # # cc[6]=".# #. #### . ### . ### .#####. # .#####. ### . ### ### # # ### ### ## # ##### # . ##### # # # # # # .# ..# #.. # . # # # # # cc[7]="......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^......^ GraphicsWindow.PenWidth=0 GraphicsWindow.BackgroundColor="tan GraphicsWindow.BrushColor="darkblue GraphicsWindow.Width=1500 GraphicsWindow.Title="ZX Screen Hommage ix="ABCDEFIOUGHJSQZTLNMKPRVWXY " For yy=50 To 840 Step 32 TXTm=LDText.Split("THE QUICK BROWN FOX JUMPS OVER LAZY DOGS" " ") txt="" For w=1 To 70 m=Math.GetRandomNumber(8) If txtm[m]="" Then Else txt=txt+txtm[m]+" " txtm[m]="" EndIf EndFor tu= Text.ConvertToUpperCase(txt) For f=1 To 40 y=0 GraphicsWindow.BrushColor=LDColours.HSLtoRGB(240 .8 math.GetRandomNumber(5)/10) r=Shapes.AddRectangle(28 32) Shapes.Move(r (f*7)*4+20 yy ) GraphicsWindow.BrushColor="orange ldShapes.AnimateOpacity(r 750 5) LDShapes.SetShapeEvent(r) Program.Delay(5) For x=0 To 6 For y=0 To 7 n=x+7*(Text.GetIndexOf(ix text.GetSubText(tu f 1))-1)+1 If Text.GetSubText(cc[y] n 1)="#" Then e=shapes.AddRectangle(4 4) shapes.move(e (x+f*7)*4+20 y*4+yy ) EndIf EndFor EndFor EndFor EndFor zz=1 LDEvents.MouseWheel=mwww LDShapes.ShapeEvent=see Sub see ls=LDShapes.LastEventShape If LDShapes.LastEventType="MouseEnter" Then ldShapes.AnimateOpacity(ls 750 5) EndIf EndSub Sub mwww zz=zz+LDEvents.LastMouseWheelDelta/15 LDGraphicsWindow.Reposition(zz zz 0 zz*100 0) EndSub End>QBF381.sb< Start>QBH071-0.sb< ' Paint ' by CodingLikeCrazy ' remix GoToLoop ' Graphics Init: GW = 1250 GH = 750 Sz = 4 GraphicsWindow.Width = GW GraphicsWindow.Height = GH GraphicsWindow.Left = (Desktop.Width - GW) / 2 ' Centralizes GraphicsWindow. GraphicsWindow.Top = (Desktop.Height - GH) / 2 GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.PenColor = "White" GraphicsWindow.PenWidth = Sz CreateColorButtons() CreateFeatureButtons() ' Event Raising Init: Button = "" Controls.ButtonClicked = OnButtonClick GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.MouseMove = OnMouseMove ' Button Wait Loop: Loop: If Button <> "" Then ' Waits until a button is selected. CheckButtons() Button = "" EndIf Program.Delay(100) ' A delay to cool CPU down! Goto Loop ' Button Feature Subroutines: '--------------------------------------------------------------------------------------------------------------------------' Sub CheckButtons If Button = "Custom" Then 'Button = Dialogs.AskForColor() ' <--- Uncomment to use this extension! SetPenColor() ElseIf Button = "Paper" Then GraphicsWindow.BackgroundColor = GraphicsWindow.PenColor ElseIf Button = "Size Up" Then If Sz < 30 Then Sz = Sz + 1 EndIf GraphicsWindow.PenWidth = Sz ElseIf Button = "Size Dn" Then If Sz > 1 Then Sz = Sz - 1 EndIf GraphicsWindow.PenWidth = Sz ElseIf Button = "Square" Then AskSquare() ' <--- Replace this w/ a more appropriate graphics extension input dialog. GraphicsWindow.BrushColor = GraphicsWindow.PenColor GraphicsWindow.FillRectangle(XC,YC W,H) ElseIf Button = "Clear" Then GraphicsWindow.Clear() CreateColorButtons() CreateFeatureButtons() ElseIf Button = "Quit" Then Sound.PlayChimeAndWait() Program.End() Else ' After all of feature buttons dismissed, assumes it's some color button now! SetPenColor() EndIf EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub SetPenColor GraphicsWindow.PenColor = Button ' Button's caption is the color itself! GraphicsWindow.Title = Button + " : " + Sz EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub AskSquare LF = Text.GetCharacter(10) '<--- Line Feed ASCII Code (jumps a line) TextWindow.Show() TextWindow.Clear() TextWindow.Write("Enter X Co-ordinate: ") XC = Math.Abs( TextWindow.ReadNumber() ) TextWindow.Write(LF + "Enter Y Co-ordinate: ") YC = Math.Abs( TextWindow.ReadNumber() ) TextWindow.Write(LF + "Enter Width: ") W = Math.Abs( TextWindow.ReadNumber() ) TextWindow.Write(LF + "Enter Height: ") H = Math.Abs( TextWindow.ReadNumber() ) TextWindow.Hide() EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub CreateColorButtons Colors = "0=Custom;1=Orange;2=Yellow;3=Red;4=Blue;5=Cyan;6=Green;7=Olive;8=Purple;" Colors = Colors + "9=Magenta;10=Pink;11=White;12=Gray;13=Black;14=SaddleBrown;" Count = Array.GetItemCount(Colors) - 1 For i=0 To Count GraphicsWindow.BrushColor = Colors[i] Controls.AddButton(Colors[i] 75*i+10,10) EndFor EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub CreateFeatureButtons GraphicsWindow.BrushColor = "Black" Controls.AddButton("Paper" 10, 50) Controls.AddButton("Size Up" 10,100) Controls.AddButton("Size Dn" 10,150) Controls.AddButton("Square" 10,200) Controls.AddButton("Clear" 10,250) Controls.AddButton("Quit" 10,300) EndSub '-----------------------------------------------------------------------------------------------------------------------------' ' Triggered Event Subs: '-----------------------------------------------------------------------------------------------------------------------------' Sub OnButtonClick Button = Controls.GetButtonCaption( Controls.LastClickedButton ) ' Grabs caption text of the last button clicked. EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub OnMouseDown PrevX = GraphicsWindow.MouseX PrevY = GraphicsWindow.MouseY EndSub '-----------------------------------------------------------------------------------------------------------------------------' Sub OnMouseMove X = GraphicsWindow.MouseX Y = GraphicsWindow.MouseY If Mouse.IsLeftButtonDown Or Mouse.IsRightButtonDown Then GraphicsWindow.DrawLine(PrevX,PrevY X,Y) EndIf PrevX = X PrevY = Y EndSub '-----------------------------------------------------------------------------------------------------------------------------' End>QBH071-0.sb< Start>QBH071.sb< GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.MouseMove = OnMouseMove Controls.ButtonClicked = OnButtonClick GraphicsWindow.Title = "Paint" GraphicsWindow.Height = 1000 GraphicsWindow.Width = 1000 GraphicsWindow.PenWidth = 2 Size = 2 GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.PenColor = "White" Figure = Controls.AddButton("Add Square", 10, 50) Custom = Controls.AddButton("Custom Color", 10, 100) Paper = Controls.AddButton("Custom Paper", 10, 150) Add = Controls.AddButton("Pen Siz Up", 10, 200) Subtract = Controls.AddButton("Pen Size Down", 10, 250) colors= "1=Red;2=Orange;3=Yellow;4=Green;5=Blue;6=Magenta;7=White;8=Teal;9=Cyan;10=Black" ' Maybe Custom???? For i=1 to 10 GraphicsWindow.BrushColor=colors[i] CLR[i]= Controls.AddButton(colors[i],10+100*(i-1),10) endfor Sub OnButtonClick If Controls.LastClickedButton = Figure Then ERR=1 GraphicsWindow.BrushColor =Dialogs.AskForColor() While ERR=1 TextWindow.clear() TextWindow.WriteLine("Enter X co-ordinate") XC = TextWindow.Read() TextWindow.WriteLine("Enter Y co-ordinate") YC = TextWindow.Read() TextWindow.WriteLine("Enter Height") H = TextWindow.Read() TextWindow.WriteLine("Enter Width") W = TextWindow.Read() GraphicsWindow.FillRectangle(XC, YC, H, W) '<--- this is right! TextWindow.Hide() If H<0 Or W < 0 Then '<---- Xc and YC accept minus value Dialogs.ShowMessageBox("ERORR!", "Error", "OKCancel", "None") ERR=1 Else ERR=0 EndIf EndWhile EndIf GraphicsWindow.PenColor=controls.GetButtonCaption(Controls.LastClickedButton) If Controls.LastClickedButton = Custom Then choice = Dialogs.AskForColor() GraphicsWindow.PenColor = choice EndIf If Controls.LastClickedButton = Paper Then pc = Dialogs.AskForColor() GraphicsWindow.BackgroundColor = pc EndIf If Controls.LastClickedButton = Add Then GraphicsWindow.PenWidth = Size+1 EndIf EndSub Sub OnMouseDown prevx = GraphicsWindow.MouseX prevy = GraphicsWindow.MouseY EndSub Sub OnMouseMove x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY If (Mouse.IsLeftButtonDown) Then GraphicsWindow.DrawLine(prevx, prevy, x, y) EndIf prevx = x prevy = y EndSub End>QBH071.sb< Start>QBJ852.sb< ' Vergo ' Version 0.11 ' おとめ ' September ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Last update 2016-08-20 ' ' Reference: ' http://en.wikipedia.org/wiki/List_of_stars_in_Vergo ' GraphicsWindow.Title = "Vergo 0.11" SB_Workaround() wrap = "False" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "Black" ' initialize shapes Shapes_Init() Cal_Init() ' add shapes scale = 1 angle = 0 iMin = 1 iMax = 110 Shapes_Add() If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 100 GraphicsWindow.BrushColor = "Gray" year = 2016 month = 9 symbol = Shapes.AddText(symbols[month]) Shapes.Move(symbol, 40, gh - 140) InitStars() 'EdgeConvert() num = Array.GetItemCount(star) index = Array.GetAllIndices(star) offsetX = 0 offsetY = 0 GetMinMax() offsetX = -xMin - 1380 offsetY = -yMin + 60 DrawGrids() GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "LightGray" num = Array.GetItemCount(edge) index = Array.GetAllIndices(edge) For i = 1 To num e = edge[index[i]] m = Text.GetIndexOf(e, "-") ra = star[Text.GetSubText(e, 1, m - 1)]["RA"] dec = star[Text.GetSubText(e, 1, m - 1)]["Dec"] RADec2XY() x1 = x y1 = y ra = star[Text.GetSubTextToEnd(e, m + 1)]["RA"] dec = star[Text.GetSubTextToEnd(e, m + 1)]["Dec"] RADec2XY() x2 = x y2 = y Shapes.AddLine(x1, y1, x2, y2) EndFor num = Array.GetItemCount(star) index = Array.GetAllIndices(star) GraphicsWindow.BrushColor = "White" GraphicsWindow.PenWidth = 0 For i = 1 To num ra = star[index[i]]["RA"] dec = star[index[i]]["Dec"] RADec2XY() mag = star[index[i]]["Mag"] d = 16 / mag ell = Shapes.AddEllipse(d, d) Shapes.Move(ell, x - d / 2, y - d / 2) EndFor GraphicsWindow.BrushColor = "White" If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 30 x = 400 y = 310 GraphicsWindow.DrawText(x, y, months[month]) If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 40 GraphicsWindow.DrawText(x, y + 30, year) sBuf = year + "," + month Command_GetArgs() iYear = sArg[1] if iYear = "" Then Goto lEnd Endif If Math.Remainder(iYear, 4) = 0 And Math.Remainder(iYear, 100) > 0 Or Math.Remainder(iYear, 400) = 0 Then iDoM[2] = iDoM[2] + 1 Endif iNoL = Math.Floor((iYear - 1) / 4) - Math.Floor((iYear - 1) / 100) + Math.Floor((iYear - 1) / 400) ' number of leap year iWoY = Math.Remainder((iYear + iNoL), 7) ' week of year iMonth = sArg[2] If iMonth = "" Then iM0 = 1 iM1 = 12 Else iM0 = iMonth iM1 = iMonth Endif iDoY = 0 ' days of year iNoM = 1 ' number of month For iM = iM0 To iM1 While iNoM < iM iDoY = iDoY + iDoM[iNoM] iNoM = iNoM + 1 EndWhile Cal_DrawMonth() EndFor lEnd: ' Blink start While "True" Program.Delay(2900) Shapes.HideShape(shape[38]["obj"]) Shapes.HideShape(shape[39]["obj"]) Shapes.HideShape(shape[40]["obj"]) Shapes.HideShape(shape[41]["obj"]) Program.Delay(100) Shapes.ShowShape(shape[38]["obj"]) Shapes.ShowShape(shape[39]["obj"]) Shapes.ShowShape(shape[40]["obj"]) Shapes.ShowShape(shape[41]["obj"]) EndWhile ' end of main Sub Cal_Init ' Calendar | Initialize days of month WQ = Text.GetCharacter(34) CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) iDoM = "1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31;" months = "1=January;2=February;3=March;4=April;5=May;6=June;7=July;" months = months + "8=August;9=September;10=October;11=November;12=December;" symbols = "1=♑;2=♒;3=♓;4=♈;5=♉;6=♊;7=♋;8=♌;9=♍;10=♎;11=♏;12=♐;" EndSub Sub Cal_DrawMonth ' Calendar | Print month ' param iM - month ' param iDoY - days of year ' param iWoY - week of year If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 16 GraphicsWindow.FontName = "Consolas" iW = Math.Remainder((iDoY + iWoY), 7) line = "SUN MON TUE WED THU FRI SAT" + CRLF iWoM = 0 While iWoM < iW line = line + " " iWoM = iWoM + 1 EndWhile For iD = 1 To iDoM[iM] If iD < 10 Then line = line + " " + iD + " " Else line = line + " " + iD + " " EndIf If Math.Remainder(iWoM, 7) = 6 Then line = line + CRLF EndIf iWoM = iWoM + 1 EndFor If Math.Remainder(iWoM, 7) > 0 Then line = line + CRLF EndIf cal = Shapes.AddText(line) Shapes.Move(cal, 50, 30) EndSub Sub Command_GetArgs ' Command line | Get arguments ' param sBuf - input buffer ' return sArg[] - arguments ' return iN - number of arguments iP = 1 ' buffer pointer iN = 1 ' number of args iC = Text.GetIndexOf(sBuf, ",") ' index of comma While iC > iP sArg[iN] = Text.GetSubText(sBuf, iP, iC - iP) iP = iC + 1 iN = iN + 1 iC = Text.GetIndexOf(sBuf, ",") EndWhile iE = Text.GetLength(sBuf) + 1 ' end of buffer sArg[iN] = Text.GetSubText(sBuf, iP, iE - iP) EndSub Sub GetMinMax For i = 1 To num ra = star[index[i]]["RA"] dec = star[index[i]]["Dec"] RADec2XY() ra1 = Text.GetSubText(ra, 1, 2) If wrap And 12 < ra1 Then ra1 = ra1 - 24 EndIf If i = 1 Then raMin = ra1 decMin = Text.GetSubText(dec, 1, 3) raMax = ra1 decMax = Text.GetSubText(dec, 1, 3) xMin = x yMin = y xMax = x yMax = y Else raMin = Math.Min(ra1, raMin) decMin = Math.Min(Text.GetSubText(dec, 1, 3), decMin) raMax = Math.Max(ra1, raMax) decMax = Math.Max(Text.GetSubText(dec, 1, 3), decMax) xMin = Math.Min(x, xMin) yMin = Math.Min(y, yMin) xMax = Math.Max(x, xMax) yMax = Math.Max(y, yMax) EndIf EndFor decMin = Math.Floor(decMin / 10) * 10 raMax = raMax + 1 decMax = decMax + 1 EndSub Sub InitStars ' Initialize stars in Virgo ' index: Flamsteed designation ' RA (Right ascension), Dec (Declination), Mag (Apparent magnitude) star["Spica"] = "ra=13 25 11.60;dec=-11 09 40.5;mag=0.98;fd=67;" star["γ Vir A"] = "ra=12 41 40.00;dec=-01 26 58.3;mag=2.74;fd=29;" star["ε Vir"] = "ra=13 02 10.76;dec=+10 57 32.8;mag=2.85;fd=47;" star["ζ Vir"] = "ra=13 34 41.75;dec=-00 35 45.4;mag=3.38;fd=79;" star["δ Vir"] = "ra=12 55 36.48;dec=+03 23 51.4;mag=3.39;fd=43;" star["β Vir"] = "ra=11 50 41.29;dec=+01 45 55.4;mag=3.59;fd=5;" star["γ Vir B"] = "ra=12 41 39.60;dec=-01 26 58.0;mag=3.68;fd=29;" star["109 Vir"] = "ra=14 46 14.99;dec=+01 53 34.6;mag=3.73;fd=109;" star["μ Vir"] = "ra=14 43 03.56;dec=-05 39 26.7;mag=3.87;fd=107;" star["η Vir"] = "ra=12 19 54.39;dec=-00 40 00.3;mag=3.89;fd=15;" star["ν Vir"] = "ra=11 45 51.57;dec=+06 31 47.3;mag=4.04;fd=3;" star["ι Vir"] = "ra=14 16 00.88;dec=-05 59 58.3;mag=4.07;fd=99;" star["ο Vir"] = "ra=12 05 12.67;dec=+08 43 58.2;mag=4.12;fd=9;" star["κ Vir"] = "ra=14 12 53.74;dec=-10 16 26.6;mag=4.18;fd=98;" star["τ Vir"] = "ra=14 01 38.78;dec=+01 32 40.5;mag=4.23;fd=93;" star["θ Vir"] = "ra=13 09 57.01;dec=-05 32 20.1;mag=4.38;fd=51;" star["110 Vir"] = "ra=15 02 54.07;dec=+02 05 28.6;mag=4.39;fd=110;" star["λ Vir"] = "ra=14 19 06.60;dec=-13 22 16.2;mag=4.52;fd=100;" star["π Vir"] = "ra=12 00 52.39;dec=+06 36 51.8;mag=4.65;fd=8;" star["χ Vir"] = "ra=12 39 14.81;dec=-07 59 43.8;mag=4.66;fd=26;" star["74 Vir"] = "ra=13 31 57.95;dec=-06 15 20.6;mag=4.68;fd=74;" star["61 Vir"] = "ra=13 18 24.97;dec=-18 18 31.0;mag=4.74;fd=61;" star["69 Vir"] = "ra=13 27 27.24;dec=-15 58 25.1;mag=4.76;fd=69;" star["ψ Vir"] = "ra=12 54 21.17;dec=-09 32 20.2;mag=4.77;fd=40;" star["σ Vir"] = "ra=13 17 36.29;dec=+05 28 11.4;mag=4.78;fd=60;" star["φ Vir"] = "ra=14 28 12.22;dec=-02 13 40.6;mag=4.81;fd=105;" star["ξ Vir"] = "ra=11 45 17.00;dec=+08 15 29.4;mag=4.84;fd=2;" star["ρ Vir"] = "ra=12 41 53.01;dec=+10 14 09.0;mag=4.88;fd=30;" star["78 Vir"] = "ra=13 34 07.91;dec=+03 39 32.5;mag=4.92;fd=78;" star["ET Vir"] = "ra=14 10 50.48;dec=-16 18 07.2;mag=4.93;" star["89 Vir"] = "ra=13 49 52.34;dec=-18 08 02.7;mag=4.96;fd=89;" star["16 Vir"] = "ra=12 20 21.15;dec=+03 18 45.8;mag=4.97;fd=16;" star["70 Vir"] = "ra=13 28 25.95;dec=+13 46 48.7;mag=4.97;fd=70;" star["CU Vir"] = "ra=14 12 15.83;dec=+02 24 34.2;mag=4.99;" star["82 Vir"] = "ra=13 41 36.83;dec=-08 42 11.1;mag=5.03;fd=82;" star["53 Vir"] = "ra=13 12 03.48;dec=-16 11 52.5;mag=5.04;fd=53;" star["244 G. Vir"] = "ra=14 24 11.39;dec=+05 49 12.4;mag=5.10;" star["υ Vir"] = "ra=14 19 32.55;dec=-02 15 55.2;mag=5.14;fd=102;" star["49 Vir"] = "ra=13 07 53.80;dec=-10 44 25.4;mag=5.15;fd=49;" star["90 Vir"] = "ra=13 54 42.20;dec=-01 30 11.1;mag=5.16;fd=90;" star["59 Vir"] = "ra=13 16 46.71;dec=+09 25 25.3;mag=5.19;fd=59;" star["57 Vir"] = "ra=13 15 58.58;dec=-19 56 34.2;mag=5.21;fd=57;" star["76 Vir"] = "ra=13 32 58.09;dec=-10 09 53.7;mag=5.21;fd=76;" star["d2 Vir"] = "ra=12 45 37.12;dec=+07 40 23.9;mag=5.22;fd=32;" star["ω Vir"] = "ra=11 38 27.61;dec=+08 08 03.4;mag=5.24;fd=1;" star["68 Vir"] = "ra=13 26 43.24;dec=-12 42 27.4;mag=5.27;fd=68;" star["4 Vir"] = "ra=11 47 54.93;dec=+08 14 45.1;mag=5.31;fd=4;" star["55 Vir"] = "ra=13 14 10.97;dec=-19 55 52.8;mag=5.31;fd=55;" star["84 Vir"] = "ra=13 43 03.88;dec=+03 32 17.1;mag=5.35;fd=84;" star["7 Vir"] = "ra=11 59 56.92;dec=+03 39 18.8;mag=5.36;fd=7;" star["63 Vir"] = "ra=13 23 01.15;dec=-17 44 06.7;mag=5.36;fd=63;" star["87 Vir"] = "ra=13 47 25.35;dec=-17 51 35.1;mag=5.41;fd=87;" star["106 Vir"] = "ra=14 28 41.73;dec=-06 54 01.5;mag=5.42;fd=106;" star["95 Vir"] = "ra=14 06 42.91;dec=-09 18 48.7;mag=5.46;fd=95;" star["21 Vir"] = "ra=12 33 46.80;dec=-09 27 07.5;mag=5.48;fd=21;" star["86 Vir"] = "ra=13 45 56.33;dec=-12 25 35.6;mag=5.50;fd=86;" star["1 Ser"] = "ra=14 57 33.22;dec=-00 10 03.2;mag=5.51;fd=(1);" star["75 Vir"] = "ra=13 32 51.69;dec=-15 21 46.8;mag=5.52;fd=75;" star["226 G. Vir"] = "ra=14 15 24.11;dec=-18 12 02.4;mag=5.53;" star["HD 104304"] = "ra=12 00 44.37;dec=-10 26 41.4;mag=5.54;" star["83 Vir"] = "ra=13 44 29.82;dec=-16 10 44.6;mag=5.55;fd=83;" star["31 Vir"] = "ra=12 41 57.16;dec=+06 48 23.9;mag=5.57;fd=31;" star["g Vir"] = "ra=13 08 32.49;dec=-08 59 03.2;mag=5.57;" star["6 Vir"] = "ra=11 55 03.15;dec=+08 26 38.1;mag=5.58;fd=6;" star["106 G. Vir"] = "ra=13 03 46.03;dec=-20 35 00.6;mag=5.58;" star["12 G. Vir"] = "ra=11 51 02.23;dec=-05 20 00.0;mag=5.62;" star["LN Vir"] = "ra=13 14 31.24;dec=+11 19 54.4;mag=5.64;" star["33 Vir"] = "ra=12 46 22.38;dec=+09 32 26.8;mag=5.65;fd=33;" star["71 Vir"] = "ra=13 29 13.04;dec=+10 49 06.2;mag=5.65;fd=71;" star["FW Vir"] = "ra=12 38 22.45;dec=+01 51 16.9;mag=5.68;" star["108 Vir"] = "ra=14 45 30.23;dec=+00 43 02.2;mag=5.68;fd=108;" star["136 G. Vir"] = "ra=13 21 41.68;dec=+02 05 14.5;mag=5.69;" star["80 Vir"] = "ra=13 35 31.29;dec=-05 23 47.0;mag=5.70;fd=80;" star["2 Ser"] = "ra=15 01 48.92;dec=-00 08 24.9;mag=5.71;fd=(2);" star["11 Vir"] = "ra=12 10 03.51;dec=+05 48 25.1;mag=5.72;fd=11;" star["66 Vir"] = "ra=13 24 33.14;dec=-05 09 50.1;mag=5.76;fd=66;" star["44 Vir"] = "ra=12 59 39.55;dec=-03 48 43.0;mag=5.79;fd=44;" star["12 Vir"] = "ra=12 13 25.99;dec=+10 15 44.5;mag=5.85;fd=12;" star["CS Vir"] = "ra=14 18 38.30;dec=-18 42 57.2;mag=5.86;" star["25 Vir"] = "ra=12 36 47.37;dec=-05 49 54.7;mag=5.88;fd=25;" star["65 Vir"] = "ra=13 23 18.91;dec=-04 55 27.8;mag=5.88;fd=65;" star["64 Vir"] = "ra=13 22 09.73;dec=+05 09 17.5;mag=5.89;fd=64;" star["224 G. Vir"] = "ra=14 13 40.67;dec=-00 50 42.4;mag=5.89;" star["13 Vir"] = "ra=12 18 40.30;dec=-00 47 13.7;mag=5.90;fd=13;" star["92 Vir"] = "ra=13 56 27.89;dec=+01 03 02.0;mag=5.90;fd=92;" star["79 G. Vir"] = "ra=12 43 38.02;dec=-01 34 36.5;mag=5.91;" star["265 G. Vir"] = "ra=14 59 23.11;dec=+04 34 04.0;mag=5.91;" star["y Vir"] = "ra=13 34 40.48;dec=-13 12 51.5;mag=5.92;" star["10 Vir"] = "ra=12 09 41.29;dec=+01 53 54.0;mag=5.95;fd=10;" star["50 G. Vir"] = "ra=12 25 11.80;dec=-11 36 37.8;mag=5.95;" star["50 Vir"] = "ra=13 09 45.29;dec=-10 19 45.5;mag=5.95;fd=50;" star["250 G. Vir"] = "ra=14 29 50.51;dec=+00 49 44.1;mag=5.96;" star["146 G. Vir"] = "ra=13 26 11.48;dec=-01 11 32.9;mag=5.97;" star["46 Vir"] = "ra=13 00 35.96;dec=-03 22 07.0;mag=5.99;fd=46;" star["92 G. Vir"] = "ra=12 54 18.74;dec=-11 38 54.9;mag=6.00;" star["194 G. Vir"] = "ra=13 50 24.67;dec=+05 29 50.0;mag=6.00;" star["73 Vir"] = "ra=13 32 02.87;dec=-18 43 43.8;mag=6.01;fd=73;" star["252 G. Vir"] = "ra=14 30 45.39;dec=+04 46 20.3;mag=6.01;" star["37 Vir"] = "ra=12 51 36.91;dec=+03 03 24.3;mag=6.02;fd=37;" star["183 G. Vir"] = "ra=13 47 13.40;dec=-09 42 33.7;mag=6.04;" star["5 G. Vir"] = "ra=11 43 55.09;dec=-06 40 37.4;mag=6.05;" star["56 G. Vir"] = "ra=12 31 21.43;dec=+07 36 15.4;mag=6.05;" star["257 G. Vir"] = "ra=14 45 11.74;dec=-01 25 03.1;mag=6.06;" star["72 Vir"] = "ra=13 30 25.70;dec=-06 28 13.1;mag=6.10;fd=72;" star["41 G. Vir"] = "ra=12 15 10.54;dec=-10 18 35.8;mag=6.11;" star["34 Vir"] = "ra=12 47 13.62;dec=+11 57 29.3;mag=6.11;fd=34;" star["38 Vir"] = "ra=12 53 11.31;dec=-03 33 11.1;mag=6.11;fd=38;" star["9 G. Vir"] = "ra=11 49 01.40;dec=-00 19 07.2;mag=6.15;" star["230 G. Vir"] = "ra=14 16 30.18;dec=-03 11 46.4;mag=6.15;" star["271 G. Vir"] = "ra=15 07 40.32;dec=+05 29 53.1;mag=6.16;" star["1 G. Vir"] = "ra=11 38 09.87;dec=+08 53 01.6;mag=6.18;" star["19 G. Vir"] = "ra=11 59 03.38;dec=+00 31 50.2;mag=6.18;" star["153 G. Vir"] = "ra=13 30 00.08;dec=+07 10 43.8;mag=6.18;" star["85 Vir"] = "ra=13 45 35.09;dec=-15 46 02.7;mag=6.18;fd=85;" star["239 G. Vir"] = "ra=14 19 40.97;dec=+00 23 03.7;mag=6.18;" star["104 Vir"] = "ra=14 27 24.42;dec=-06 07 12.7;mag=6.18;fd=104;" star["261 G. Vir"] = "ra=14 51 00.11;dec=-00 15 27.0;mag=6.18;" star["57 G. Vir"] = "ra=12 31 38.74;dec=-05 03 09.6;mag=6.19;" star["199 G. Vir"] = "ra=13 54 58.30;dec=-08 03 31.6;mag=6.19;" star["135 G. Vir"] = "ra=13 21 29.82;dec=-19 29 21.4;mag=6.21;" star["3 G. Vir"] = "ra=11 38 24.09;dec=-02 26 09.4;mag=6.22;" star["27 Vir"] = "ra=12 41 34.46;dec=+10 25 34.6;mag=6.22;fd=27;" star["231 G. Vir"] = "ra=14 17 03.79;dec=-18 35 08.5;mag=6.22;" star["FT Vir"] = "ra=12 27 51.60;dec=-04 36 55.0;mag=6.23;" star["27 G. Vir"] = "ra=12 02 51.68;dec=-07 41 01.2;mag=6.24;" star["209 G. Vir"] = "ra=14 03 55.76;dec=+04 54 03.5;mag=6.24;" star["41 Vir"] = "ra=12 53 49.67;dec=+12 25 06.6;mag=6.25;fd=41;" star["243 G. Vir"] = "ra=14 23 15.15;dec=+01 14 33.8;mag=6.25;" star["54 Vir"] = "ra=13 13 26.85;dec=-18 49 35.0;mag=6.26;fd=54;" star["134 G. Vir"] = "ra=13 20 41.61;dec=+02 56 32.3;mag=6.26;" star["85 G. Vir"] = "ra=12 47 33.42;dec=-06 18 05.9;mag=6.27;" star["213 G. Vir"] = "ra=14 04 37.45;dec=+02 17 51.1;mag=6.28;" star["20 Vir"] = "ra=12 33 02.91;dec=+10 17 44.4;mag=6.29;fd=20;" star["208 G. Vir"] = "ra=14 03 53.10;dec=-22 25 17.8;mag=6.30;" star["IQ Vir"] = "ra=11 53 50.30;dec=+00 33 07.6;mag=6.31;" star["EP Vir"] = "ra=12 47 02.29;dec=+05 57 01.8;mag=6.31;" star["26 G. Vir"] = "ra=12 01 01.75;dec=-01 46 04.8;mag=6.32;" star["112 G. Vir"] = "ra=13 09 14.27;dec=-09 32 17.2;mag=6.32;" star["207 G. Vir"] = "ra=14 03 04.18;dec=-17 22 01.2;mag=6.32;" star["68 G. Vir"] = "ra=12 38 04.43;dec=+03 16 56.9;mag=6.33;" star["98 G. Vir"] = "ra=12 57 12.68;dec=-12 04 00.9;mag=6.33;" star["185 G. Vir"] = "ra=13 46 57.42;dec=+06 21 02.3;mag=6.33;" star["210 G. Vir"] = "ra=14 04 27.00;dec=-14 58 18.0;mag=6.35;" star["51 G. Vir"] = "ra=12 27 42.07;dec=+08 36 37.3;mag=6.36;" star["129 G. Vir"] = "ra=13 17 29.89;dec=-00 40 33.7;mag=6.36;" star["204 G. Vir"] = "ra=13 59 49.30;dec=-03 32 58.7;mag=6.36;" star["225 G. Vir"] = "ra=14 14 21.49;dec=-05 56 52.5;mag=6.36;" star["33 G. Vir"] = "ra=12 05 59.83;dec=-03 07 53.6;mag=6.37;" star["29 G. Vir"] = "ra=12 03 44.53;dec=+05 33 28.6;mag=6.39;" star["211 G. Vir"] = "ra=14 04 14.57;dec=-05 22 53.0;mag=6.39;" star["FS Vir"] = "ra=14 14 53.05;dec=+03 20 09.4;mag=6.41;" star["35 Vir"] = "ra=12 47 51.42;dec=+03 34 21.8;mag=6.42;fd=35;" star["150 G. Vir"] = "ra=13 29 14.94;dec=-01 21 51.4;mag=6.42;" star["221 G. Vir"] = "ra=14 11 31.28;dec=+01 21 44.4;mag=6.42;" star["240 G. Vir"] = "ra=14 19 53.25;dec=-06 44 46.0;mag=6.42;" star["141 G. Vir"] = "ra=13 23 57.11;dec=-20 55 28.3;mag=6.44;" star["229 G. Vir"] = "ra=14 16 21.41;dec=-06 37 17.5;mag=6.44;" star["91 G. Vir"] = "ra=12 53 38.12;dec=-04 13 28.2;mag=6.45;" star["96 Vir"] = "ra=14 09 00.60;dec=-10 20 04.6;mag=6.45;fd=96;" star["254 G. Vir"] = "ra=14 37 28.49;dec=+02 16 38.7;mag=6.45;" star["17 Vir"] = "ra=12 22 32.14;dec=+05 18 20.1;mag=6.46;fd=17;" star["49 G. Vir"] = "ra=12 23 15.35;dec=-04 58 28.0;mag=6.47;" star["233 G. Vir"] = "ra=14 16 48.75;dec=-08 53 04.0;mag=6.47;" star["235 G. Vir"] = "ra=14 18 00.57;dec=-07 32 30.5;mag=6.47;" star["88 G. Vir"] = "ra=12 51 22.93;dec=-10 20 17.6;mag=6.48;" star["20 G. Vir"] = "ra=11 59 09.38;dec=-10 28 33.5;mag=6.49;" star["94 Vir"] = "ra=14 06 17.77;dec=-08 53 30.0;mag=6.54;fd=94;" star["48 Vir"] = "ra=13 03 54.44;dec=-03 39 47.0;mag=6.62;fd=48;" star["S Vir"] = "ra=13 33 00.70;dec=-07 11 42.0;mag=6.68;" star["62 Vir"] = "ra=13 20 20.05;dec=-11 18 14.8;mag=6.73;fd=62;" star["28 Vir"] = "ra=12 41 57.68;dec=-07 30 00.7;mag=6.81;fd=28;" star["56 Vir"] = "ra=13 14 45.13;dec=-10 22 13.0;mag=6.95;fd=56;" star["MARI"] = "ra=12 44 20.24;dec=-07 30 07.0;mag=6.0;" edge = "1=β Vir-η Vir;2=η Vir-γ Vir A;3=γ Vir A-δ Vir;4=δ Vir-ε Vir;5=γ Vir A-θ Vir;" edge = edge + "6=θ Vir-Spica;7=Spica-ζ Vir;" EndSub Sub EdgeConvert n = Array.GetItemCount(edge) nStar = Array.GetItemCount(star) index = Array.GetAllIndices(star) buf = "edge = " + WQ For j = 1 To n buf = buf + j + "=" minus = Text.GetIndexOf(edge[j], "-") fd = Text.GetSubText(edge[j], 1, minus - 1) For i = 1 To nStar If fd = star[index[i]]["fd"] Then buf = buf + index[i] + "-" i = nStar ' exit For EndIf EndFor fd = Text.GetSubTextToEnd(edge[j], minus + 1) For i = 1 To nStar If fd = star[index[i]]["fd"] Then buf = buf + index[i] + ";" i = nStar ' exit For EndIf EndFor If (j = 5) Or ((5 < j) And (Math.Remainder(j, 4) = 1)) Then buf = buf + WQ + CRLF buf = buf + "edge = edge + " + WQ EndIf EndFor buf = buf + WQ + CRLF GraphicsWindow.FontSize = 12 tbox = Controls.AddMultiLineTextBox(0, 0) Shapes.SetOpacity(tbox, 50) Controls.SetSize(tbox, gw, gh) Controls.SetTextBoxText(tbox, buf) EndSub Sub DrawGrids If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "DimGray" GraphicsWindow.BrushColor = "DimGray" GraphicsWindow.FontSize = 12 y1 = 0 y2 = GraphicsWindow.Height For ra = raMin To raMax RADec2XY() Shapes.AddLine(x, y1, x, y2) raTxt = ra If wrap And raTxt < 0 Then raTxt = raTxt + 24 EndIf txt = Shapes.AddText(raTxt + "h") Shapes.Move(txt, x, 5) EndFor x1 = 0 x2 = GraphicsWindow.Width For dec = decMin To decMax + 10 Step 10 If dec > 0 Then dec = Text.Append("+", Math.Abs(dec)) EndIf RADec2XY() Shapes.AddLine(x1, y, x2, y) txt = Shapes.AddText(dec) Shapes.Move(txt, x1, y) EndFor EndSub Sub RADec2XY ' param ra - right ascension ' param dec - declination ' return x, y x = Text.GetSubText(ra, 1, 2) If wrap And 12 < x Then x = x - 24 EndIf x = x + Text.GetSubText(ra, 4, 2) / 60 x = x + Text.GetSubText(ra, 7, 5) / 3600 x = offsetX - (x - raMin) * 3600 / 24 y = Text.GetSubText(dec, 2, 2) y = y + Text.GetSubText(dec, 5, 2) / 60 y = y + Text.GetSubText(dec, 8, 5) / 3600 y = y * Text.Append(Text.GetSubText(dec, 1, 1), "1") y = offsetY - y * 3600 / 360 EndSub Sub Shapes_Init ' Shapes | Initialize shapes data ' return shX, shY - current position of shapes ' return shape - array of shapes shX = 88 ' x offset shY = 91 ' y offset shape = "" shape[1] = "func=tri;x=191;y=17;x1=58;y1=0;x2=0;y2=247;x3=117;y3=247;angle=77;bc=#BFB9EA;pw=0;" shape[2] = "func=rect;x=37;y=151;width=78;height=19;angle=347;bc=#E5B3A9;pw=0;" shape[3] = "func=rect;x=52;y=195;width=77;height=20;angle=346;bc=#E5B3A9;pw=0;" shape[4] = "func=tri;x=135;y=33;x1=58;y1=0;x2=0;y2=247;x3=117;y3=247;angle=77;bc=#BFB9EA;pw=0;" shape[5] = "func=ell;x=0;y=159;width=57;height=21;angle=2;bc=#E5B3A9;pw=0;" shape[6] = "func=ell;x=16;y=210;width=57;height=21;angle=322;bc=#E5B3A9;pw=0;" shape[7] = "func=ell;x=184;y=198;width=30;height=22;angle=324;bc=#E5B3A9;pw=0;" shape[8] = "func=rect;x=204;y=179;width=83;height=17;angle=341;bc=#E5B3A9;pw=0;" shape[9] = "func=rect;x=278;y=148;width=85;height=23;angle=336;bc=#BFB9EA;pw=0;" shape[10] = "func=rect;x=258;y=87;width=83;height=17;angle=20;bc=#E5B3A9;pw=0;" shape[11] = "func=rect;x=275;y=88;width=76;height=65;angle=347;bc=#BFB9EA;pw=0;" shape[12] = "func=line;x=193;y=173;x1=14;y1=0;x2=0;y2=68;pc=#AD8834;pw=2;" shape[13] = "func=tri;x=243;y=0;x1=58;y1=0;x2=0;y2=247;x3=117;y3=247;angle=77;bc=#BFB9EA;pw=0;" shape[14] = "func=rect;x=373;y=90;width=34;height=24;angle=345;bc=#E5B3A9;pw=0;" shape[15] = "func=ell;x=196;y=213;width=12;height=7;angle=53;bc=#AD8834;pw=0;" shape[16] = "func=ell;x=185;y=221;width=14;height=9;angle=322;bc=#AD8834;pw=0;" shape[17] = "func=ell;x=182;y=234;width=12;height=8;angle=322;bc=#AD8834;pw=0;" shape[18] = "func=ell;x=187;y=210;width=13;height=9;angle=322;bc=#AD8834;pw=0;" shape[19] = "func=ell;x=195;y=227;width=12;height=7;angle=53;bc=#AD8834;pw=0;" shape[20] = "func=ell;x=192;y=238;width=12;height=7;angle=53;bc=#AD8834;pw=0;" shape[21] = "func=ell;x=240;y=70;width=30;height=22;angle=355;bc=#E5B3A9;pw=0;" shape[22] = "func=ell;x=416;y=55;width=43;height=59;angle=342;bc=#AD8834;pw=0;" shape[23] = "func=ell;x=410;y=109;width=22;height=18;bc=#AD8834;pw=0;" shape[24] = "func=ell;x=391;y=62;width=22;height=18;angle=338;bc=#AD8834;pw=0;" shape[25] = "func=ell;x=375;y=73;width=24;height=18;angle=332;bc=#AD8834;pw=0;" shape[26] = "func=rect;x=348;y=82;width=39;height=54;angle=348;bc=#E5B3A9;pw=0;" shape[27] = "func=rect;x=323;y=74;width=60;height=21;angle=340;bc=#BFB9EA;pw=0;" shape[28] = "func=rect;x=336;y=125;width=60;height=21;angle=353;bc=#BFB9EA;pw=0;" shape[29] = "func=ell;x=388;y=109;width=23;height=18;bc=#AD8834;pw=0;" shape[30] = "func=ell;x=391;y=68;width=58;height=48;angle=345;bc=#EDCBC4;pw=0;" shape[31] = "func=ell;x=409;y=54;width=36;height=20;bc=#AD8834;pw=0;" shape[32] = "func=ell;x=425;y=95;width=36;height=20;angle=320;bc=#AD8834;pw=0;" shape[33] = "func=ell;x=374;y=108;width=19;height=19;bc=#AD8834;pw=0;" shape[34] = "func=ell;x=360;y=109;width=19;height=19;bc=#AD8834;pw=0;" shape[35] = "func=ell;x=344;y=114;width=19;height=14;bc=#AD8834;pw=0;" shape[36] = "func=ell;x=329;y=113;width=19;height=14;bc=#AD8834;pw=0;" shape[37] = "func=ell;x=317;y=115;width=19;height=14;angle=343;bc=#AD8834;pw=0;" shape[38] = "func=ell;x=413;y=75;width=7;height=12;angle=343;bc=#FFFFFF;pw=0;" shape[39] = "func=ell;x=421;y=95;width=7;height=12;angle=343;bc=#FFFFFF;pw=0;" shape[40] = "func=ell;x=412;y=74;width=9;height=9;angle=343;bc=#2B4D8D;pw=0;" shape[41] = "func=ell;x=420;y=94;width=9;height=9;angle=343;bc=#2B4D8D;pw=0;" shape[42] = "func=tri;x=397;y=95;x1=7;y1=0;x2=0;y2=5;x3=14;y3=5;angle=247;bc=#820808;pw=0;" shape[43] = "func=ell;x=195;y=123;width=38;height=12;angle=343;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[44] = "func=ell;x=216;y=110;width=38;height=12;angle=336;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[45] = "func=ell;x=221;y=117;width=38;height=12;angle=336;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[46] = "func=ell;x=239;y=111;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[47] = "func=ell;x=234;y=107;width=38;height=12;angle=342;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[48] = "func=ell;x=235;y=99;width=38;height=12;angle=332;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[49] = "func=ell;x=270;y=105;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[50] = "func=ell;x=267;y=101;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[51] = "func=ell;x=260;y=93;width=38;height=12;angle=339;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[52] = "func=ell;x=258;y=84;width=38;height=12;angle=334;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[53] = "func=ell;x=298;y=97;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[54] = "func=ell;x=282;y=91;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[55] = "func=ell;x=275;y=83;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[56] = "func=ell;x=321;y=87;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[57] = "func=ell;x=303;y=87;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[58] = "func=ell;x=296;y=82;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[59] = "func=ell;x=290;y=74;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[60] = "func=ell;x=278;y=70;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[61] = "func=ell;x=335;y=79;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[62] = "func=ell;x=328;y=74;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[63] = "func=ell;x=314;y=71;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[64] = "func=ell;x=306;y=66;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[65] = "func=ell;x=303;y=60;width=38;height=12;angle=338;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[66] = "func=ell;x=353;y=67;width=38;height=12;angle=327;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[67] = "func=ell;x=347;y=64;width=38;height=12;angle=327;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[68] = "func=ell;x=335;y=62;width=38;height=12;angle=334;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[69] = "func=ell;x=329;y=58;width=38;height=12;angle=342;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[70] = "func=ell;x=334;y=50;width=38;height=12;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[71] = "func=ell;x=361;y=60;width=26;height=13;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[72] = "func=ell;x=364;y=53;width=26;height=13;angle=345;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[73] = "func=ell;x=360;y=48;width=26;height=13;angle=356;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[74] = "func=ell;x=216;y=163;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[75] = "func=ell;x=242;y=164;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[76] = "func=ell;x=239;y=155;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[77] = "func=ell;x=273;y=163;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[78] = "func=ell;x=266;y=156;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[79] = "func=ell;x=266;y=147;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[80] = "func=ell;x=304;y=163;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[81] = "func=ell;x=297;y=155;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[82] = "func=ell;x=294;y=149;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[83] = "func=ell;x=290;y=140;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[84] = "func=ell;x=333;y=163;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[85] = "func=ell;x=329;y=156;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[86] = "func=ell;x=324;y=148;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[87] = "func=ell;x=320;y=139;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[88] = "func=ell;x=317;y=132;width=38;height=12;angle=351;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[89] = "func=ell;x=363;y=155;width=38;height=12;angle=343;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[90] = "func=ell;x=357;y=151;width=38;height=12;angle=346;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[91] = "func=ell;x=354;y=144;width=38;height=12;angle=352;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[92] = "func=ell;x=349;y=139;width=38;height=12;angle=352;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[93] = "func=ell;x=348;y=131;width=38;height=12;angle=355;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[94] = "func=ell;x=347;y=127;width=38;height=12;angle=355;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[95] = "func=ell;x=385;y=145;width=32;height=12;angle=328;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[96] = "func=ell;x=382;y=140;width=32;height=12;angle=340;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[97] = "func=ell;x=380;y=133;width=32;height=12;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[98] = "func=ell;x=377;y=128;width=32;height=12;angle=5;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[99] = "func=ell;x=395;y=138;width=24;height=13;angle=326;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[100] = "func=ell;x=394;y=135;width=24;height=13;angle=343;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[101] = "func=ell;x=393;y=131;width=24;height=13;angle=3;bc=#B8B8B8;pc=#7D7D7D;pw=1;" shape[102] = "func=line;x=217;y=80;x1=0;y1=6;x2=30;y2=0;pc=#17480F;pw=4;" shape[103] = "func=line;x=268;y=61;x1=42;y1=0;x2=0;y2=13;pc=#17480F;pw=4;" shape[104] = "func=line;x=310;y=44;x1=0;y1=17;x2=40;y2=0;pc=#17480F;pw=4;" shape[105] = "func=line;x=350;y=33;x1=0;y1=11;x2=23;y2=0;pc=#17480F;pw=4;" shape[106] = "func=ell;x=268;y=48;width=64;height=7;angle=319;bc=#17480F;pw=0;" shape[107] = "func=ell;x=287;y=42;width=64;height=7;angle=319;bc=#17480F;pw=0;" shape[108] = "func=ell;x=308;y=35;width=64;height=7;angle=319;bc=#17480F;pw=0;" shape[109] = "func=ell;x=333;y=25;width=64;height=7;angle=319;bc=#17480F;pw=0;" shape[110] = "func=ell;x=358;y=14;width=64;height=7;angle=319;bc=#17480F;pw=0;" EndSub Sub Math_CartesianToPolar ' Math | convert cartesian coodinate to polar coordinate ' param x, y - cartesian coordinate ' return r, a - polar coordinate r = Math.SquareRoot(x * x + y * y) If x = 0 And y > 0 Then a = 90 ' [degree] ElseIf x = 0 And y < 0 Then a = -90 ElseIf x = 0 Then a = 0 Else a = Math.ArcTan(y / x) * 180 / Math.Pi EndIf If x < 0 Then a = a + 180 ElseIf x > 0 And y < 0 Then a = a + 360 EndIf EndSub Sub SB_RotateWorkaround ' Small Basic | Rotate workaround for Silverlight ' param shp - current shape ' param x, y - original coordinate ' param alpha - angle [radian] ' returns x, y - workaround coordinate If shp["func"] = "tri" Then x1 = -Math.Floor(shp["x3"] / 2) y1 = -Math.Floor(shp["y3"] / 2) ElseIf shp["func"] = "line" Then x1 = -Math.Floor(Math.Abs(shp["x1"] - shp["x2"]) / 2) y1 = -Math.Floor(Math.Abs(shp["y1"] - shp["y2"]) / 2) EndIf ox = x - x1 oy = y - y1 x = x1 * Math.Cos(alpha) - y1 * Math.Sin(alpha) + ox y = x1 * Math.Sin(alpha) + y1 * Math.Cos(alpha) + oy EndSub Sub SB_Workaround ' Small Basic | Workaround for Silverlight ' returns silverlight - "True" if in remote color = GraphicsWindow.GetPixel(0, 0) If Text.GetLength(color) > 7 Then silverlight = "True" msWait = 300 Else silverlight = "False" EndIf EndSub Sub Shapes_Add ' Shapes | add shapes as shapes data ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - 1 if same scale ' return shWidth, shHeight - total size of shapes ' return shAngle - current angle of shapes Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) Shapes_CalcWidthAndHeight() s = scale For i = iMin To iMax shp = shape[i] GraphicsWindow.PenWidth = shp["pw"] * s If shp["pw"] > 0 Then GraphicsWindow.PenColor = shp["pc"] EndIf If Text.IsSubText("rect|ell|tri|text", shp["func"]) Then GraphicsWindow.BrushColor = shp["bc"] EndIf If shp["func"] = "rect" Then shp["obj"] = Shapes.AddRectangle(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "ell" Then shp["obj"] = Shapes.AddEllipse(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "tri" Then shp["obj"] = Shapes.AddTriangle(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s, shp["x3"] * s, shp["y3"] * s) ElseIf shp["func"] = "line" Then shp["obj"] = Shapes.AddLine(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s) ElseIf shp["func"] = "text" Then If silverlight Then fs = Math.Floor(shp["fs"] * 0.9) Else fs = shp["fs"] EndIf If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = fs * s GraphicsWindow.FontName = shp["fn"] shp["obj"] = Shapes.AddText(shp["text"]) EndIf x = shp["x"] y = shp["y"] shp["rx"] = x shp["ry"] = y If silverlight And Text.IsSubText("tri|line", shp["func"]) Then alpha = Math.GetRadians(shp["angle"]) SB_RotateWorkaround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], shX + x * s, shY + y * s) If Text.IsSubText("rect|ell|tri|text", shp["func"]) And (shp["angle"] <> 0) And (shp["angle"] <> "") Then Shapes.Rotate(shp["obj"], shp["angle"]) EndIf shape[i] = shp EndFor shAngle = 0 y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub Sub Shapes_CalcRotatePos ' Shapes | Calculate position for rotated shape ' param["x"], param["y"] - position of a shape ' param["width"], param["height"] - size of a shape ' param ["cx"], param["cy"] - center of rotation ' param ["angle"] - rotate angle ' return x, y - rotated position of a shape _cx = param["x"] + param["width"] / 2 _cy = param["y"] + param["height"] / 2 x = _cx - param["cx"] y = _cy - param["cy"] Math_CartesianToPolar() a = a + param["angle"] x = r * Math.Cos(a * Math.Pi / 180) y = r * Math.Sin(a * Math.Pi / 180) _cx = x + param["cx"] _cy = y + param["cy"] x = _cx - param["width"] / 2 y = _cy - param["height"] / 2 EndSub Sub Shapes_CalcWidthAndHeight ' Shapes | Calculate total width and height of shapes ' param iMin, iMax - shape indices to add ' return shWidth, shHeight - total size of shapes For i = iMin To iMax shp = shape[i] If shp["func"] = "tri" Or shp["func"] = "line" Then xmin = shp["x1"] xmax = shp["x1"] ymin = shp["y1"] ymax = shp["y1"] If shp["x2"] < xmin Then xmin = shp["x2"] EndIf If xmax < shp["x2"] Then xmax = shp["x2"] EndIf If shp["y2"] < ymin Then ymin = shp["y2"] EndIf If ymax < shp["y2"] Then ymax = shp["y2"] EndIf If shp["func"] = "tri" Then If shp["x3"] < xmin Then xmin = shp["x3"] EndIf If xmax < shp["x3"] Then xmax = shp["x3"] EndIf If shp["y3"] < ymin Then ymin = shp["y3"] EndIf If ymax < shp["y3"] Then ymax = shp["y3"] EndIf EndIf shp["width"] = xmax - xmin shp["height"] = ymax - ymin EndIf If i = 1 Then shWidth = shp["x"] + shp["width"] shHeight = shp["y"] + shp["height"] Else If shWidth < shp["x"] + shp["width"] Then shWidth = shp["x"] + shp["width"] EndIf If shHeight < shp["y"] + shp["height"] Then shHeight = shp["y"] + shp["height"] EndIf EndIf shape[i] = shp EndFor EndSub Sub Shapes_Move ' Shapes | Move shapes ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - to zoom ' param x, y - position to move ' return shX, shY - new position of shapes Stack.PushValue("local", i) s = scale shX = x shY = y For i = iMin To iMax shp = shape[i] If silverlight And Text.IsSubText("tri|line", shp["func"]) Then _x = shp["wx"] _y = shp["wy"] Else _x = shp["rx"] _y = shp["ry"] EndIf Shapes.Move(shp["obj"], shX + _x * s, shY + _y * s) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Remove ' Shapes | Remove shapes ' param iMin, iMax - shapes indices to remove ' param shape - array of shapes Stack.PushValue("local", i) For i = iMin To iMax shp = shape[i] Shapes.Remove(shp["obj"]) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Rotate ' Shapes | Rotate shapes ' param iMin, iMax - shapes indices to rotate ' param shape - array of shapes ' param cx, cy - rotation center ' param scale - to zoom ' param angle - to rotate Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) s = scale param["angle"] = angle If cx <> "" Then param["cx"] = cx Else cx = "" ' to avoid syntax error param["cx"] = shWidth / 2 EndIf If cy <> "" Then param["cy"] = cy Else cy = "" ' to avoid syntax error param["cy"] = shHeight / 2 EndIf For i = iMin To iMax shp = shape[i] param["x"] = shp["x"] param["y"] = shp["y"] param["width"] = shp["width"] param["height"] = shp["height"] Shapes_CalcRotatePos() shp["rx"] = x shp["ry"] = y If silverlight And Text.IsSubText("tri|line", shp["func"]) Then alpha = Math.GetRadians(angle + shp["angle"]) SB_RotateWorkAround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], shX + x * s, shY + y * s) Shapes.Rotate(shp["obj"], angle + shp["angle"]) shape[i] = shp EndFor y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub End>QBJ852.sb< Start>QBK201.sb< For i = 1 To 3 End = Math.Power(10, i) DisplayAverageOfRands() EndFor Sub DisplayAverageOfRands For j = 1 To End Total = Total + Math.GetRandomNumber(100) EndFor TextWindow.WriteLine("Average of " + End + " numbers: " + Total / End) EndSub End>QBK201.sb< Start>QBT006.sb< ///*Berkeley Logo User Manual >>Here are the special features of this dialect of Logo: Source file compatible among Unix, DOS, Windows, and Mac platforms. Random-access arrays. Variable number of inputs to user-defined procedures. Mutators for list structure (dangerous). Pause on error, and other improvements to error handling. Comments and continuation lines; formatting is preserved when procedure definitions are saved or edited. Terrapin-style tokenization (e.g., [2+3] is a list with one member) but LCSI-style syntax (no special forms except TO). The best of both worlds. First-class instruction and expression templates (see APPLY). Macros. ///GETTER/SETTER VARIBLE SYNTAX >>Logo distinguishes PROCEDURES from VARIABLES. A procedure is a set of instructions to carry out some computation; a variable is a named container that holds a data value such as a number, word, list, or array. In traditional Logo syntax, a non-numeric word typed without punctuation represents a request to invoke the procedure named by that word. A word typed with a preceding quotation mark represents the word itself. For example, in the instruction PRINT FIRST "WORD the procedures named FIRST and PRINT are invoked, but the procedure named WORD is not invoked; the word W-O-R-D is the input to FIRST. What about variables? There are two things one can do with a variable: give it a value, and find out its value. To give a variable a value, Logo provides the primitive procedure MAKE, which requires two inputs: the name of the variable and the new value to be assigned. The first input, the name of the variable, is just a word, and if (as is almost always the case) the programmer wants to assign a value to a specific variable whose name is known in advance, that input is quoted, just as any known specific word would be: MAKE "MY.VAR FIRST "WORD gives the variable named MY.VAR the value W (the first letter of WORD). To find the value of a variable, Logo provides the primitive procedure THING, which takes a variable name as its input, and outputs the value of the accessible variable with that name. Thus PRINT THING "MY.VAR will print W (supposing the MAKE above has been done). Since finding the value of a specific, known variable name is such a common operation, Logo also provides an abbreviated notation that combines THING with quote: PRINT :MY.VAR The colon (which Logo old-timers pronounce "dots") replaces THING and " in the earlier version of the instruction. Newcomers to Logo often complain about the need for all this punctuation. In particular, Logo programmers who learned about dots and quotes without also learning about THING wonder why an instruction such as MAKE "NEW.VAR :OLD.VAR uses two different punctuation marks to identify the two variables. (Having read the paragraphs above, you will understand that actually both variable names are quoted, but the procedure THING is invoked to find the value of OLD.VAR, since it's that value, not OLD.VAR's name, that MAKE needs to know. It wouldn't make sense to ask for THING of NEW.VAR, since we haven't given NEW.VAR a value yet.) Although Logo's punctuation rules make sense once understood, they do form a barrier to entry for the Logo beginner. Why, then, couldn't Logo be designed so that an unpunctuated word would represent a procedure if there is a procedure by that name, or a variable if there is a variable by that name? Then we could say PRINT MY.VAR and Logo would realize that MY.VAR is the name of a variable, not of a procedure. The traditional reason not to use this convention is that Logo allows the same word to name a procedure and a variable at the same time. This is most often important for words that name data types, as in the following procedure: TO PLURAL :WORD OUTPUT WORD :WORD "S END Here the name WORD is a natural choice for the input to PLURAL, since it describes the kind of input that PLURAL expects. Within the procedure, we use WORD to represent Logo's primitive procedure that combines two input words to form a new, longer word; we use :WORD to represent the variable containing the input, whatever actual word is given when PLURAL is invoked. ? PRINT PLURAL "COMPUTER COMPUTERS However, if a Logo instruction includes an unquoted word that is *not* the name of a procedure, Logo could look for a variable of that name instead. This would allow a "punctuationless" Logo, ** PROVIDED THAT USERS WHO WANT TO WORK WITHOUT COLONS FOR VARIABLES CHOOSE VARIABLE NAMES THAT ARE NOT ALSO PROCEDURE NAMES. ** What about assigning a value to a variable? Could we do without the quotation mark on MAKE's first input? Alas, no. Although the first input to MAKE is *usually* a constant, known variable name, sometimes it isn't, as in this example: TO INCREMENT :VAR MAKE :VAR (THING :VAR)+1 ; Note: it's not "VAR here! END ? MAKE "X 5 ? INCREMENT "X ? PRINT :X 6 The procedure INCREMENT takes a variable name as its input and changes the value of that variable. In this example there are two variables; the variable whose name is VAR, and whose value is the word X; and the variable whose name is X and whose value changes from 5 to 6. Suppose we changed the behavior of MAKE so that it took the word after MAKE as the name of the variable to change; we would be unable to write INCREMENT: TO INCREMENT :VAR ; nonworking! MAKE VAR (THING VAR)+1 END This would assign a new value to VAR, not to X. What we can do is to allow an *alternative* to MAKE, a "setter" procedure for a particular variable. The notation will be ? SETFOO 7 ? PRINT FOO 7 SETFOO is a "setter procedure" that takes one input (in this case the input 7) and assigns its value to the variable named FOO. Berkeley Logo allows users to choose either the traditional notation, in which case the same name can be used both for a procedure and for a variable, or the getter/setter notation, in which variable FOO is set with SETFOO and examined with FOO, but the same name can't be used for procedure and variable. Here is how this choice is allowed: Berkeley Logo uses traditional notation, with procedures distinct from variables. However, if there is a variable named AllowGetSet whose value is TRUE (which there is, by default, when Logo starts up), then if a Logo instruction refers to a *nonexistent* procedure (so that the error message "I don't know how to ..." would result), Logo tries the following two steps: 1. If the name is at least four characters long, and the first three characters are the letters SET (upper or lower case), and if the name is followed in the instruction by another value, and if the name without the SET is the name of a variable that already exists, then Logo will invoke MAKE with its first input being the name without the SET, and its second input being the following value. 2. If step 1's conditions are not met, but the name is the name of an accessible variable, then Logo will invoke THING with that name as input, to find the variable's value. Step 1 requires that the variable already exist so that misspellings of names of SETxxx primitives (e.g., SETHEADING) will still be caught, instead of silently creating a new variable. The command GLOBAL can be used to create a variable without giving it a value. One final point: The TO command in Logo has always been a special case; the rest of the line starting with TO is not evaluated as ordinary Logo expressions are. In particular, the colons used to mark the names of inputs to the procedure do not cause THING to be invoked. They are merely mnemonic aids, reminding the Logo user that these words are names of variables. (Arguably, this nonstantard behavior of TO adds to Logo beginners' confusion about colons.) To a programmer using colonless variable references, the colons in the TO line are unnecessary and meaningless. Berkeley Logo therefore makes the colons optional: TO FOO :IN1 :IN2 and TO FOO IN1 IN2 are both allowed. ///TOKENIZATION >>Names of procedures, variables, and property lists are case-insensitive. So are the special words END, TRUE, and FALSE. Case of letters is preserved in everything you type, however. Within square brackets, words are delimited only by spaces and square brackets. [2+3] is a list containing one word. Note, however, that the Logo primitives that interpret such a list as a Logo instruction or expression (RUN, IF, etc.) reparse the list as if it had not been typed inside brackets. After a quotation mark outside square brackets, a word is delimited by a space, a square bracket, or a parenthesis. A word not after a quotation mark or inside square brackets is delimited by a space, a bracket, a parenthesis, or an infix operator +-*/=<>. Note that words following colons are in this category. Note that quote and colon are not delimiters. Each infix operator character is a word in itself, except that the two-character sequences <= >= and <> (the latter meaning not-equal) with no intervening space are recognized as a single word. A word consisting of a question mark followed by a number (e.g., ?37), when runparsed (i.e., where a procedure name is expected), is treated as if it were the sequence ( ? 37 ) making the number an input to the ? procedure. (See the discussion of templates, below.) This special treatment does not apply to words read as data, to words with a non-number following the question mark, or if the question mark is backslashed. A line (an instruction line or one read by READLIST or READWORD) can be continued onto the following line if its last character is a tilde (~). READWORD preserves the tilde and the newline; READLIST does not. Lines read with READRAWLINE are never continued. An instruction line or a line read by READLIST (but not by READWORD) is automatically continued to the next line, as if ended with a tilde, if there are unmatched brackets, parentheses, braces, or vertical bars pending. However, it's an error if the continuation line contains only the word END; this is to prevent runaway procedure definitions. Lines eplicitly continued with a tilde avoid this restriction. If a line being typed interactively on the keyboard is continued, either with a tilde or automatically, Logo will display a tilde as a prompt character for the continuation line. A semicolon begins a comment in an instruction line. Logo ignores characters from the semicolon to the end of the line. A tilde as the last character still indicates a continuation line, but not a continuation of the comment. For example, typing the instruction print "abc;comment ~ def will print the word abcdef. Semicolon has no special meaning in data lines read by READWORD or READLIST, but such a line can later be reparsed using RUNPARSE and then comments will be recognized. The two-character sequence #! at the beginning of a line also starts a comment. Unix users can therefore write a file containing Logo commands, starting with the line #! /usr/local/bin/logo (or wherever your Logo executable lives) and the file will be executable directly from the shell. To include an otherwise delimiting character (including semicolon or tilde) in a word, precede it with backslash (\). If the last character of a line is a backslash, then the newline character following the backslash will be part of the last word on the line, and the line continues onto the following line. To include a backslash in a word, use \\. If the combination backslash-newline is entered at the terminal, Logo will issue a backslash as a prompt character for the continuation line. All of this applies to data lines read with READWORD or READLIST as well as to instruction lines. A line read with READRAWLINE has no special quoting mechanism; both backslash and vertical bar (described below) are just ordinary characters. An alternative notation to include otherwise delimiting characters in words is to enclose a group of characters in vertical bars. All characters between vertical bars are treated as if they were letters. In data read with READWORD the vertical bars are preserved in the resulting word. In data read with READLIST (or resulting from a PARSE or RUNPARSE of a word) the vertical bars do not appear explicitly; all potentially delimiting characters (including spaces, brackets, parentheses, and infix operators) appear unmarked, but tokenized as though they were letters. Within vertical bars, backslash may still be used; the only characters that must be backslashed in this context are backslash and vertical bar themselves. Characters entered between vertical bars are forever special, even if the word or list containing them is later reparsed with PARSE or RUNPARSE. Characters typed after a backslash are treated somewhat differently: When a quoted word containing a backslashed character is runparsed, the backslashed character loses its special quality and acts thereafter as if typed normally. This distinction is important only if you are building a Logo expression out of parts, to be RUN later, and want to use parentheses. For example, PRINT RUN (SE "\( 2 "+ 3 "\)) will print 5, but RUN (SE "MAKE ""|(| 2) will create a variable whose name is open-parenthesis. (Each example would fail if vertical bars and backslashes were interchanged.) A character entered with backslash is EQUALP to the same character without the backslash, but can be distinguished by the VBARREDP predicate. (However, VBARREDP returns TRUE only for characters for which special treatment is necessary: whitespace, parentheses, brackets, infix operators, backslash, vertical bar, tilde, quote, question mark, colon, and semicolon.) ///DATA STRUCTURE PRIMITIVES **CONSTRUCTORS >>WORD word1 word2 (WORD word1 word2 word3 ...) outputs a word formed by concatenating its inputs. >>LIST thing1 thing2 (LIST thing1 thing2 thing3 ...) outputs a list whose members are its inputs, which can be any Logo datum (word, list, or array). >>SENTENCE thing1 thing2 SE thing1 thing2 (SENTENCE thing1 thing2 thing3 ...) (SE thing1 thing2 thing3 ...) outputs a list whose members are its inputs, if those inputs are not lists, or the members of its inputs, if those inputs are lists. >>FPUT thing list outputs a list equal to its second input with one extra member, the first input, at the beginning. If the second input is a word, then the first input must be a one-letter word, and FPUT is equivalent to WORD. >>LPUT thing list outputs a list equal to its second input with one extra member, the first input, at the end. If the second input is a word, then the first input must be a one-letter word, and LPUT is equivalent to WORD with its inputs in the other order. >>ARRAY size (ARRAY size origin) outputs an array of "size" members (must be a positive integer), each of which initially is an empty list. Array members can be selected with ITEM and changed with SETITEM. The first member of the array is member number 1 unless an "origin" input (must be an integer) is given, in which case the first member of the array has that number as its index. (Typically 0 is used as the origin if anything.) Arrays are printed by PRINT and friends, and can be typed in, inside curly braces; indicate an origin with {a b c}@0. >>MDARRAY sizelist (library procedure) (MDARRAY sizelist origin) outputs a multi-dimensional array. The first input must be a list of one or more positive integers. The second input, if present, must be a single integer that applies to every dimension of the array. Ex: (MDARRAY [3 5] 0) outputs a two-dimensional array whose members range from [0 0] to [2 4]. >>LISTTOARRAY list (LISTTOARRAY list origin) outputs an array of the same size as the input list, whose members are the members of the input list. >>ARRAYTOLIST array outputs a list whose members are the members of the input array. The first member of the output is the first member of the array, regardless of the array's origin. >>COMBINE thing1 thing2 (library procedure) if thing2 is a word, outputs WORD thing1 thing2. If thing2 is a list, outputs FPUT thing1 thing2. >>REVERSE list (library procedure) outputs a list whose members are the members of the input list, in reverse order. >>GENSYM (library procedure) outputs a unique word each time it's invoked. The words are of the form G1, G2, etc. **SELECTORS >>FIRST thing if the input is a word, outputs the first character of the word. If the input is a list, outputs the first member of the list. If the input is an array, outputs the origin of the array (that is, the INDEX OF the first member of the array). >>FIRSTS list outputs a list containing the FIRST of each member of the input list. It is an error if any member of the input list is empty. (The input itself may be empty, in which case the output is also empty.) This could be written as to firsts :list output map "first :list end but is provided as a primitive in order to speed up the iteration tools MAP, MAP.SE, and FOREACH. to transpose :matrix if emptyp first :matrix [op []] op fput firsts :matrix transpose bfs :matrix end >>LAST wordorlist if the input is a word, outputs the last character of the word. If the input is a list, outputs the last member of the list. >>BUTFIRST wordorlist BF wordorlist if the input is a word, outputs a word containing all but the first character of the input. If the input is a list, outputs a list containing all but the first member of the input. >>BUTFIRSTS list BFS list outputs a list containing the BUTFIRST of each member of the input list. It is an error if any member of the input list is empty or an array. (The input itself may be empty, in which case the output is also empty.) This could be written as to butfirsts :list output map "butfirst :list end but is provided as a primitive in order to speed up the iteration tools MAP, MAP.SE, and FOREACH. >>BUTLAST wordorlist BL wordorlist if the input is a word, outputs a word containing all but the last character of the input. If the input is a list, outputs a list containing all but the last member of the input. >>ITEM index thing if the "thing" is a word, outputs the "index"th character of the word. If the "thing" is a list, outputs the "index"th member of the list. If the "thing" is an array, outputs the "index"th member of the array. "Index" starts at 1 for words and lists; the starting index of an array is specified when the array is created. >>MDITEM indexlist array (library procedure) outputs the member of the multidimensional "array" selected by the list of numbers "indexlist". >>PICK list (library procedure) outputs a randomly chosen member of the input list. >>REMOVE thing list (library procedure) outputs a copy of "list" with every member equal to "thing" removed. >>REMDUP list (library procedure) outputs a copy of "list" with duplicate members removed. If two or more members of the input are equal, the rightmost of those members is the one that remains in the output. >>QUOTED thing (library procedure) outputs its input, if a list; outputs its input with a quotation mark prepended, if a word. **MUTATORS >>SETITEM index array value command. Replaces the "index"th member of "array" with the new "value". Ensures that the resulting array is not circular, i.e., "value" may not be a list or array that contains "array". >>MDSETITEM indexlist array value (library procedure) command. Replaces the member of "array" chosen by "indexlist" with the new "value". >>.SETFIRST list value command. Changes the first member of "list" to be "value". WARNING: Primitives whose names start with a period are DANGEROUS. Their use by non-experts is not recommended. The use of .SETFIRST can lead to circular list structures, which will get some Logo primitives into infinite loops, and to unexpected changes to other data structures that share storage with the list being modified. >>.SETBF list value command. Changes the butfirst of "list" to be "value". WARNING: Primitives whose names start with a period are DANGEROUS. Their use by non-experts is not recommended. The use of .SETBF can lead to circular list structures, which will get some Logo primitives into infinite loops; unexpected changes to other data structures that share storage with the list being modified; or to Logo crashes and coredumps if the butfirst of a list is not itself a list. >>.SETITEM index array value command. Changes the "index"th member of "array" to be "value", like SETITEM, but without checking for circularity. WARNING: Primitives whose names start with a period are DANGEROUS. Their use by non-experts is not recommended. The use of .SETITEM can lead to circular arrays, which will get some Logo primitives into infinite loops. >>PUSH stackname thing (library procedure) command. Adds the "thing" to the stack that is the value of the variable whose name is "stackname". This variable must have a list as its value; the initial value should be the empty list. New members are added at the front of the list. >>POP stackname (library procedure) outputs the most recently PUSHed member of the stack that is the value of the variable whose name is "stackname" and removes that member from the stack. >>QUEUE queuename thing (library procedure) command. Adds the "thing" to the queue that is the value of the variable whose name is "queuename". This variable must have a list as its value; the initial value should be the empty list. New members are added at the back of the list. >>DEQUEUE queuename (library procedure) outputs the least recently QUEUEd member of the queue that is the value of the variable whose name is "queuename" and removes that member from the queue. **PREDICATES >>WORDP thing WORD? thing outputs TRUE if the input is a word, FALSE otherwise. >>LISTP thing LIST? thing outputs TRUE if the input is a list, FALSE otherwise. >>ARRAYP thing ARRAY? thing outputs TRUE if the input is an array, FALSE otherwise. >>EMPTYP thing EMPTY? thing outputs TRUE if the input is the empty word or the empty list, FALSE otherwise. >>EQUALP thing1 thing2 EQUAL? thing1 thing2 thing1 = thing2 outputs TRUE if the inputs are equal, FALSE otherwise. Two numbers are equal if they have the same numeric value. Two non-numeric words are equal if they contain the same characters in the same order. If there is a variable named CASEIGNOREDP whose value is TRUE, then an upper case letter is considered the same as the corresponding lower case letter. (This is the case by default.) Two lists are equal if their members are equal. An array is only equal to itself; two separately created arrays are never equal even if their members are equal. (It is important to be able to know if two expressions have the same array as their value because arrays are mutable; if, for example, two variables have the same array as their values then performing SETITEM on one of them will also change the other.) >>NOTEQUALP thing1 thing2 NOTEQUAL? thing1 thing2 thing1 <> thing2 outputs FALSE if the inputs are equal, TRUE otherwise. See EQUALP for the meaning of equality for different data types. >>BEFOREP word1 word2 BEFORE? word1 word2 outputs TRUE if word1 comes before word2 in ASCII collating sequence (for words of letters, in alphabetical order). Case-sensitivity is determined by the value of CASEIGNOREDP. Note that if the inputs are numbers, the result may not be the same as with LESSP; for example, BEFOREP 3 12 is false because 3 collates after 1. >>.EQ thing1 thing2 outputs TRUE if its two inputs are the same datum, so that applying a mutator to one will change the other as well. Outputs FALSE otherwise, even if the inputs are equal in value. WARNING: Primitives whose names start with a period are DANGEROUS. Their use by non-experts is not recommended. The use of mutators can lead to circular data structures, infinite loops, or Logo crashes. >>MEMBERP thing1 thing2 MEMBER? thing1 thing2 if "thing2" is a list or an array, outputs TRUE if "thing1" is EQUALP to a member of "thing2", FALSE otherwise. If "thing2" is a word, outputs TRUE if "thing1" is a one-character word EQUALP to a character of "thing2", FALSE otherwise. >>SUBSTRINGP thing1 thing2 SUBSTRING? thing1 thing2 if "thing1" or "thing2" is a list or an array, outputs FALSE. If "thing2" is a word, outputs TRUE if "thing1" is EQUALP to a substring of "thing2", FALSE otherwise. >>NUMBERP thing NUMBER? thing outputs TRUE if the input is a number, FALSE otherwise. >>VBARREDP char VBARRED? char BACKSLASHEDP char (library procedure) BACKSLASHED? char (library procedure) outputs TRUE if the input character was originally entered into Logo within vertical bars (|) to prevent its usual special syntactic meaning, FALSE otherwise. (Outputs TRUE only if the character is a backslashed space, tab, newline, or one of ()[]+-*/=<>":;\~?| ) The names BACKSLASHEDP and BACKSLASHED? are included in the Logo library for backward compatibility with the former names of this primitive, although it does *not* output TRUE for characters originally entered with backslashes. **QUERIES >>COUNT thing outputs the number of characters in the input, if the input is a word; outputs the number of members in the input, if it is a list or an array. (For an array, this may or may not be the index of the last member, depending on the array's origin.) >>ASCII char outputs the integer (between 0 and 255) that represents the input character in the ASCII code. Interprets control characters as representing vbarred punctuation, and returns the character code for the corresponding punctuation character without vertical bars. (Compare RAWASCII.) >>RAWASCII char outputs the integer (between 0 and 255) that represents the input character in the ASCII code. Interprets control characters as representing themselves. To find out the ASCII code of an arbitrary keystroke, use RAWASCII RC. >>CHAR int outputs the character represented in the ASCII code by the input, which must be an integer between 0 and 255. >>MEMBER thing1 thing2 if "thing2" is a word or list and if MEMBERP with these inputs would output TRUE, outputs the portion of "thing2" from the first instance of "thing1" to the end. If MEMBERP would output FALSE, outputs the empty word or list according to the type of "thing2". It is an error for "thing2" to be an array. >>LOWERCASE word outputs a copy of the input word, but with all uppercase letters changed to the corresponding lowercase letter. >>UPPERCASE word outputs a copy of the input word, but with all lowercase letters changed to the corresponding uppercase letter. >>STANDOUT thing outputs a word that, when printed, will appear like the input but displayed in standout mode (boldface, reverse video, or whatever your version does for standout). The word contains machine-specific magic characters at the beginning and end; in between is the printed form (as if displayed using TYPE) of the input. The output is always a word, even if the input is of some other type, but it may include spaces and other formatting characters. Note: a word output by STANDOUT while Logo is running on one machine will probably not have the desired effect if printed on another type of machine. In the Macintosh classic version, the way that standout works is incompatible with the use of characters whose ASCII code is greater than 127. Therefore, you have a choice to make: The instruction CANINVERSE 0 disables standout, but enables the display of ASCII codes above 127, and the instruction CANINVERSE 1 restores the default situation in which standout is enabled and the extra graphic characters cannot be printed. >>PARSE word outputs the list that would result if the input word were entered in response to a READLIST operation. That is, PARSE READWORD has the same value as READLIST for the same characters read. >>RUNPARSE wordorlist outputs the list that would result if the input word or list were entered as an instruction line; characters such as infix operators and parentheses are separate members of the output. Note that sublists of a runparsed list are not themselves runparsed. ///COMMUNICATION **TRANSMITTERS >>Note: If there is a variable named PRINTDEPTHLIMIT with a nonnegative integer value, then complex list and array structures will be printed only to the allowed depth. That is, members of members of... of members will be allowed only so far. The members omitted because they are just past the depth limit are indicated by an ellipsis for each one, so a too-deep list of two members will print as [... ...]. If there is a variable named PRINTWIDTHLIMIT with a nonnegative integer value, then only the first so many members of any array or list will be printed. A single ellipsis replaces all missing data within the structure. The width limit also applies to the number of characters printed in a word, except that a PRINTWIDTHLIMIT between 0 and 9 will be treated as if it were 10 when applied to words. This limit applies not only to the top-level printed datum but to any substructures within it. If there is a variable named FULLPRINTP whose value is TRUE, then words that were created using backslash or vertical bar (to include characters that would otherwise not be treated as part of a word) are printed with the backslashes or vertical bars shown, so that the printed result could be re-read by Logo to produce the same value. If FULLPRINTP is TRUE then the empty word (however it was created) prints as ||. (Otherwise it prints as nothing at all.) >>PRINT thing PR thing (PRINT thing1 thing2 ...) (PR thing1 thing2 ...) command. Prints the input or inputs to the current write stream (initially the screen). All the inputs are printed on a single line, separated by spaces, ending with a newline. If an input is a list, square brackets are not printed around it, but brackets are printed around sublists. Braces are always printed around arrays. >>TYPE thing (TYPE thing1 thing2 ...) command. Prints the input or inputs like PRINT, except that no newline character is printed at the end and multiple inputs are not separated by spaces. Note: printing to the terminal is ordinarily "line buffered"; that is, the characters you print using TYPE will not actually appear on the screen until either a newline character is printed (for example, by PRINT or SHOW) or Logo tries to read from the keyboard (either at the request of your program or after an instruction prompt). This buffering makes the program much faster than it would be if each character appeared immediately, and in most cases the effect is not disconcerting. To accommodate programs that do a lot of positioned text display using TYPE, Logo will force printing whenever SETCURSOR is invoked. This solves most buffering problems. Still, on occasion you may find it necessary to force the buffered characters to be printed explicitly; this can be done using the WAIT command. WAIT 0 will force printing without actually waiting. >>SHOW thing (SHOW thing1 thing2 ...) command. Prints the input or inputs like PRINT, except that if an input is a list it is printed inside square brackets. **RECEIVERS >>READLIST RL reads a line from the read stream (initially the keyboard) and outputs that line as a list. The line is separated into members as though it were typed in square brackets in an instruction. If the read stream is a file, and the end of file is reached, READLIST outputs the empty word (not the empty list). READLIST processes backslash, vertical bar, and tilde characters in the read stream; the output list will not contain these characters but they will have had their usual effect. READLIST does not, however, treat semicolon as a comment character. >>READWORD RW reads a line from the read stream and outputs that line as a word. The output is a single word even if the line contains spaces, brackets, etc. If the read stream is a file, and the end of file is reached, READWORD outputs the empty list (not the empty word). READWORD processes backslash, vertical bar, and tilde characters in the read stream. In the case of a tilde used for line continuation, the output word DOES include the tilde and the newline characters, so that the user program can tell exactly what the user entered. Vertical bars in the line are also preserved in the output. Backslash characters are not preserved in the output. >>READRAWLINE reads a line from the read stream and outputs that line as a word. The output is a single word even if the line contains spaces, brackets, etc. If the read stream is a file, and the end of file is reached, READRAWLINE outputs the empty list (not the empty word). READRAWLINE outputs the exact string of characters as they appear in the line, with no special meaning for backslash, vertical bar, tilde, or any other formatting characters. >>READCHAR RC reads a single character from the read stream and outputs that character as a word. If the read stream is a file, and the end of file is reached, READCHAR outputs the empty list (not the empty word). If the read stream is the keyboard, echoing is turned off when READCHAR is invoked, and remains off until READLIST or READWORD is invoked or a Logo prompt is printed. Backslash, vertical bar, and tilde characters have no special meaning in this context. >>READCHARS num RCS num reads "num" characters from the read stream and outputs those characters as a word. If the read stream is a file, and the end of file is reached, READCHARS outputs the empty list (not the empty word). If the read stream is a terminal, echoing is turned off when READCHARS is invoked, and remains off until READLIST or READWORD is invoked or a Logo prompt is printed. Backslash, vertical bar, and tilde characters have no special meaning in this context. **TERMINAL ACCESS >>KEYP/KEY? predicate, outputs TRUE if there are characters waiting to be read from the read stream. If the read stream is a file, this is equivalent to NOT EOFP. If the read stream is the terminal, then echoing is turned off and the terminal is set to CBREAK (character at a time instead of line at a time) mode. It remains in this mode until some line-mode reading is requested (e.g., READLIST). The Unix operating system forgets about any pending characters when it switches modes, so the first KEYP invocation will always output FALSE. >>CLEARTEXT/CT command. Clears the text window. >>SETCURSOR vector command. The input is a list of two numbers, the x and y coordinates of a text window position (origin in the upper left corner, positive direction is southeast). The text cursor is moved to the requested position. This command also forces the immediate printing of any buffered characters. >>CURSOR outputs a list containing the current x and y coordinates of the text cursor. Logo may get confused about the current cursor position if, e.g., you type in a long line that wraps around or your program prints escape codes that affect the screen strangely. >>SETMARGINS vector command. The input must be a list of two numbers, as for SETCURSOR. The effect is to clear the screen and then arrange for all further printing to be shifted down and to the right according to the indicated margins. Specifically, every time a newline character is printed (explicitly or implicitly) Logo will type x_margin spaces, and on every invocation of SETCURSOR the margins will be added to the input x and y coordinates. (CURSOR will report the cursor position relative to the margins, so that this shift will be invisible to Logo programs.) The purpose of this command is to accommodate the display of terminal screens in lecture halls with inadequate TV monitors that miss the top and left edges of the screen. >>SETTEXTCOLOR/SETTC foreground background command (wxWidgets only). The inputs are color numbers, or RGB color lists, as for turtle graphics. The foreground and background colors for the textscreen/splitscreen text window are changed to the given values. The change affects text already printed as well as future text printing; there is only one text color for the entire window. command (non-wxWidgets Windows and DOS extended only). The inputs are color numbers, as for turtle graphics. Future printing to the text window will use the specified colors for foreground (the characters printed) and background (the space under those characters). Using STANDOUT will revert to the default text window colors. In the DOS extended (ucblogo.exe) version, colors in textscreen mode are limited to numbers 0-7, and the coloring applies only to text printed by the program, not to the echoing of text typed by the user. Neither limitation applies to the text portion of splitscreen mode, which is actually drawn as graphics internally. ///ARITHMETIC **NUMERIC OPERATIONS >>SUM num1 num2 (SUM num1 num2 num3 ...) num1 + num2 outputs the sum of its inputs. >>DIFFERENCE num1 num2 num1 - num2 outputs the difference of its inputs. Minus sign means infix difference in ambiguous contexts (when preceded by a complete expression), unless it is preceded by a space and followed by a nonspace. (See also MINUS.) >>MINUS num - num outputs the negative of its input. Minus sign means unary minus if the previous token is an infix operator or open parenthesis, or it is preceded by a space and followed by a nonspace. There is a difference in binding strength between the two forms: MINUS 3 + 4 means -(3+4) - 3 + 4 means (-3)+4 >>PRODUCT num1 num2 (PRODUCT num1 num2 num3 ...) num1 * num2 outputs the product of its inputs. >>QUOTIENT num1 num2 (QUOTIENT num) num1 / num2 outputs the quotient of its inputs. The quotient of two integers is an integer if and only if the dividend is a multiple of the divisor. (In other words, QUOTIENT 5 2 is 2.5, not 2, but QUOTIENT 4 2 is 2, not 2.0 -- it does the right thing.) With a single input, QUOTIENT outputs the reciprocal of the input. >>REMAINDER num1 num2 outputs the remainder on dividing "num1" by "num2"; both must be integers and the result is an integer with the same sign as num1. >>MODULO num1 num2 outputs the remainder on dividing "num1" by "num2"; both must be integers and the result is an integer with the same sign as num2. >>INT num outputs its input with fractional part removed, i.e., an integer with the same sign as the input, whose absolute value is the largest integer less than or equal to the absolute value of the input. >>ROUND num outputs the nearest integer to the input. >>SQRT num outputs the square root of the input, which must be nonnegative. >>POWER num1 num2 outputs "num1" to the "num2" power. If num1 is negative, then num2 must be an integer. >>EXP num outputs e (2.718281828+) to the input power. >>LOG10 num outputs the common logarithm of the input. >>LN num outputs the natural logarithm of the input. >>SIN/RADSIN degrees/rads outputs the sine of its input, which is taken in degr/rads >>COS/RADCOS degrees outputs the cosine of its input, which is taken in degrees. >>ARCTAN num (ARCTAN x y) outputs the arctangent, in degrees, of its input. With two inputs, outputs the arctangent of y/x, if x is nonzero, or 90 or -90 depending on the sign of y, if x is zero. >>RADARCTAN num (RADARCTAN x y) outputs the arctangent, in radians, of its input. With two inputs, outputs the arctangent of y/x, if x is nonzero, or pi/2 or -pi/2 depending on the sign of y, if x is zero. The expression 2*(RADARCTAN 0 1) can be used to get the value of pi. >>ISEQ from to (library procedure) outputs a list of the integers from FROM to TO, inclusive. ? show iseq 3 7 [3 4 5 6 7] ? show iseq 7 3 [7 6 5 4 3] >>RSEQ from to count (library procedure) outputs a list of COUNT equally spaced rational numbers between FROM and TO, inclusive. ? show rseq 3 5 9 [3 3.25 3.5 3.75 4 4.25 4.5 4.75 5] ? show rseq 3 5 5 [3 3.5 4 4.5 5] **PREDICATES >>LESSP/LESS? num1 num2 num1 < num2 outputs TRUE if its first input is strictly less than its second. >>GREATERP/GREATER? num1 num2 num1 > num2 outputs TRUE if its first input is strictly greater than its second. >>LESSEQUALP num1 num2 LESSEQUAL? num1 num2 num1 <= num2 outputs TRUE if its first input is less than or equal to its second. >>GREATEREQUALP num1 num2 GREATEREQUAL? num1 num2 num1 >= num2 outputs TRUE if its first input is greater than or equal to its second. **RANDOM NUMBERS >>RANDOM num (RANDOM start end) with one input, outputs a random nonnegative integer less than its input, which must be a positive integer. With two inputs, RANDOM outputs a random integer greater than or equal to the first input, and less than or equal to the second input. Both inputs must be integers, and the first must be less than the second. (RANDOM 0 9) is equivalent to RANDOM 10; (RANDOM 3 8) is equivalent to (RANDOM 6)+3. >>RERANDOM (RERANDOM seed) command. Makes the results of RANDOM reproducible. Ordinarily the sequence of random numbers is different each time Logo is used. If you need the same sequence of pseudo-random numbers repeatedly, e.g. to debug a program, say RERANDOM before the first invocation of RANDOM. If you need more than one repeatable sequence, you can give RERANDOM an integer input; each possible input selects a unique sequence of numbers. **PRINT FORMATTING >>FORM num width precision outputs a word containing a printable representation of "num", possibly preceded by spaces (and therefore not a number for purposes of performing arithmetic operations), with at least "width" characters, including exactly "precision" digits after the decimal point. (If "precision" is 0 then there will be no decimal point in the output.) As a debugging feature, (FORM num -1 format) will print the floating point "num" according to the C printf "format", to allow to hex :num op form :num -1 "|%08X %08X| end to allow finding out the exact result of floating point operations. The precise format needed may be machine-dependent. **BITWISE OPERATIONS >>BITAND num1 num2 (BITAND num1 num2 num3 ...) outputs the bitwise AND of its inputs, which must be integers. >>BITOR num1 num2 (BITOR num1 num2 num3 ...) outputs the bitwise OR of its inputs, which must be integers. >>BITXOR num1 num2 (BITXOR num1 num2 num3 ...) outputs the bitwise EXCLUSIVE OR of its inputs, which must be integers. >>BITNOT num outputs the bitwise NOT of its input, which must be an integer. >>ASHIFT num1 num2 outputs "num1" arithmetic-shifted to the left by "num2" bits. If num2 is negative, the shift is to the right with sign extension. The inputs must be integers. >>LSHIFT num1 num2 outputs "num1" logical-shifted to the left by "num2" bits. If num2 is negative, the shift is to the right with zero fill. The inputs must be integers. ///LOGICAL OPERATIONS >>AND tf1 tf2 (AND tf1 tf2 tf3 ...) outputs TRUE if all inputs are TRUE, otherwise FALSE. All inputs must be TRUE or FALSE. (Comparison is case-insensitive regardless of the value of CASEIGNOREDP. That is, "true" or "True" or "TRUE" are all the same.) An input can be a list, in which case it is taken as an expression to run; that expression must produce a TRUE or FALSE value. List expressions are evaluated from left to right; as soon as a FALSE value is found, the remaining inputs are not examined. Example: MAKE "RESULT AND [NOT (:X = 0)] [(1 / :X) > .5] to avoid the division by zero if the first part is false. >>OR tf1 tf2 (OR tf1 tf2 tf3 ...) outputs TRUE if any input is TRUE, otherwise FALSE. All inputs must be TRUE or FALSE. (Comparison is case-insensitive regardless of the value of CASEIGNOREDP. That is, "true" or "True" or "TRUE" are all the same.) An input can be a list, in which case it is taken as an expression to run; that expression must produce a TRUE or FALSE value. List expressions are evaluated from left to right; as soon as a TRUE value is found, the remaining inputs are not examined. Example: IF OR :X=0 [some.long.computation] [...] to avoid the long computation if the first condition is met. >>NOT tf outputs TRUE if the input is FALSE, and vice versa. The input can be a list, in which case it is taken as an expression to run; that expression must produce a TRUE or FALSE value. ///GRAPHICS >>Berkeley Logo provides traditional Logo turtle graphics with one turtle. Multiple turtles, dynamic turtles, and collision detection are not supported. This is the most hardware-dependent part of Logo; some features may exist on some machines but not others. Nevertheless, the goal has been to make Logo programs as portable as possible, rather than to take fullest advantage of the capabilities of each machine. In particular, Logo attempts to scale the screen so that turtle coordinates [-100 -100] and [100 100] fit on the graphics window, and so that the aspect ratio is 1:1. The center of the graphics window (which may or may not be the entire screen, depending on the machine used) is turtle location [0 0]. Positive X is to the right; positive Y is up. Headings (angles) are measured in degrees clockwise from the positive Y axis. (This differs from the common mathematical convention of measuring angles counterclockwise from the positive X axis.) The turtle is represented as an isoceles triangle; the actual turtle position is at the midpoint of the base (the short side). However, the turtle is drawn one step behind its actual position, so that the display of the base of the turtle's triangle does not obscure a line drawn perpendicular to it (as would happen after drawing a square). Colors are, of course, hardware-dependent. However, Logo provides partial hardware independence by interpreting color numbers 0 through 7 uniformly on all computers: 0 black 1 blue 2 green 3 cyan 4 red 5 magenta 6 yellow 7 white Where possible, Logo provides additional user-settable colors; how many are available depends on the hardware and operating system environment. If at least 16 colors are available, Logo tries to provide uniform initial settings for the colors 8-15: 8 brown 9 tan 10 forest 11 aqua 12 salmon 13 purple 14 orange 15 grey Logo begins with a black background and white pen. **TURTLE MOTION >>FORWARD/FD dist moves the turtle forward, in the direction that it's facing, by the specified distance (measured in turtle steps). >>BACK/BK dist moves the turtle backward, i.e., exactly opposite to the direction that it's facing, by the specified distance. (The heading of the turtle does not change.) >>LEFT/LT degrees turns the turtle counterclockwise by the specified angle, measured in degrees (1/360 of a circle). >>RIGHT/RT degrees turns the turtle clockwise by the specified angle, measured in degrees (1/360 of a circle). >>SETPOS pos moves the turtle to an absolute position in the graphics window. The input is a list of two numbers, the X and Y coordinates. >>SETXY xcor ycor moves the turtle to an absolute position in the graphics window. The two inputs are numbers, the X and Y coordinates. >>SETX xcor moves the turtle horizontally from its old position to a new absolute horizontal coordinate. The input is the new X coordinate. >>SETY ycor moves the turtle vertically from its old position to a new absolute vertical coordinate. The input is the new Y coordinate. >>SETHEADING/SETH degrees turns the turtle to a new absolute heading. The input is a number, the heading in degrees clockwise from the positive Y axis. >>HOME moves the turtle to the center of the screen. Equivalent to SETPOS [0 0] SETHEADING 0. >>ARC angle radius draws an arc of a circle, with the turtle at the center, with the specified radius, starting at the turtle's heading and extending clockwise through the specified angle. The turtle does not move. **TURTLE MOTION QUERIES >>POS outputs the turtle's current position, as a list of two numbers, the X and Y coordinates. >>XCOR (library procedure) outputs a number, the turtle's X coordinate. >>YCOR (library procedure) outputs a number, the turtle's Y coordinate. >>HEADING outputs a number, the turtle's heading in degrees. >>TOWARDS pos outputs a number, the heading at which the turtle should be facing so that it would point from its current position to the position given as the input. >>SCRUNCH outputs a list containing two numbers, the X and Y scrunch factors, as used by SETSCRUNCH. (But note that SETSCRUNCH takes two numbers as inputs, not one list of numbers.) **TURTLE AND WINDOW CONTROL >>SHOWTURTLE/ST makes the turtle visible. >>HIDETURTLE/HT makes the turtle invisible. It's a good idea to do this while you're in the middle of a complicated drawing, because hiding the turtle speeds up the drawing substantially. >>CLEAN erases all lines that the turtle has drawn on the graphics window. The turtle's state (position, heading, pen mode, etc.) is not changed. >>CLEARSCREEN/CS erases the graphics window and sends the turtle to its initial position and heading. Like HOME and CLEAN together. >>WRAP tells the turtle to enter wrap mode: From now on, if the turtle is asked to move past the boundary of the graphics window, it will "wrap around" and reappear at the opposite edge of the window. The top edge wraps to the bottom edge, while the left edge wraps to the right edge. (So the window is topologically equivalent to a torus.) This is the turtle's initial mode. Compare WINDOW and FENCE. >>WINDOW tells the turtle to enter window mode: From now on, if the turtle is asked to move past the boundary of the graphics window, it will move offscreen. The visible graphics window is considered as just part of an infinite graphics plane; the turtle can be anywhere on the plane. (If you lose the turtle, HOME will bring it back to the center of the window.) Compare WRAP and FENCE. >>FENCE tells the turtle to enter fence mode: From now on, if the turtle is asked to move past the boundary of the graphics window, it will move as far as it can and then stop at the edge with an "out of bounds" error message. Compare WRAP and WINDOW. >>FILL fills in a region of the graphics window containing the turtle and bounded by lines that have been drawn earlier. This is not portable; it doesn't work for all machines, and may not work exactly the same way on different machines. >>FILLED color instructions runs the instructions, remembering all points visited by turtle motion commands, starting *and ending* with the turtle's initial position. Then draws (ignoring penmode) the resulting polygon, in the current pen color, filling the polygon with the given color, which can be a color number or an RGB list. The instruction list cannot include another FILLED invocation. >>LABEL text takes a word or list as input, and prints the input on the graphics window, starting at the turtle's position. >>SETLABELHEIGHT height command (wxWidgets only). Takes a positive integer argument and tries to set the font size so that the character height (including descenders) is that many turtle steps. This will be different from the number of screen pixels if SETSCRUNCH has been used. Also, note that SETSCRUNCH changes the font size to try to preserve this height in turtle steps. Note that the query operation corresponding to this command is LABELSIZE, not LABELHEIGHT, because it tells you the width as well as the height of characters in the current font. >>TEXTSCREEN/TS rearranges the size and position of windows to maximize the space available in the text window (the window used for interaction with Logo). The details differ among machines. Compare SPLITSCREEN and FULLSCREEN. >>FULLSCREEN/FS rearranges the size and position of windows to maximize the space available in the graphics window. The details differ among machines. Compare SPLITSCREEN and TEXTSCREEN. Since there must be a text window to allow printing (including the printing of the Logo prompt), Logo automatically switches from fullscreen to splitscreen whenever anything is printed. In the DOS version, switching from fullscreen to splitscreen loses the part of the picture that's hidden by the text window. [This design decision follows from the scarcity of memory, so that the extra memory to remember an invisible part of a drawing seems too expensive.] >>SPLITSCREEN/SS rearranges the size and position of windows to allow some room for text interaction while also keeping most of the graphics window visible. The details differ among machines. Compare TEXTSCREEN and FULLSCREEN. >>SETSCRUNCH xscale yscale adjusts the aspect ratio and scaling of the graphics display. After this command is used, all further turtle motion will be adjusted by multiplying the horizontal and vertical extent of the motion by the two numbers given as inputs. For example, after the instruction "SETSCRUNCH 2 1" motion at a heading of 45 degrees will move twice as far horizontally as vertically. If your squares don't come out square, try this. (Alternatively, you can deliberately misadjust the aspect ratio to draw an ellipse.) In wxWidgets only, SETSCRUNCH also changes the size of the text font used for the LABEL command to try to keep the height of characters scaled with the vertical turtle step size. For all modern computers For DOS machines, the scale factors are initially set according to what the hardware claims the aspect ratio is, but the hardware sometimes lies. For DOS, the values set by SETSCRUNCH are remembered in a file (called SCRUNCH.DAT) and are automatically put into effect when a Logo session begins. >>REFRESH (command) tells Logo to remember the turtle's motions so that they can be used for high-resolution printing (wxWidgets) or to refresh the graphics window if it is moved, resized, or overlayed (non-wxWidgets). This is the default. >>NOREFRESH (command) tells Logo not to remember the turtle's motions, which may be useful to save time and memory if your program is interactive or animated, rather than drawing a static picture you'll want to print later (wxWidgets). In non-wxWidgets versions, using NOREFRESH may prevent Logo from restoring the graphics image after the window is moved, resized, or overlayed. **TURTLE AND WINDOW QUERIES >>SHOWNP/SHOWN? outputs TRUE if the turtle is shown (visible), FALSE if the turtle is hidden. See SHOWTURTLE and HIDETURTLE. >>SCREENMODE outputs the word TEXTSCREEN, SPLITSCREEN, or FULLSCREEN depending on the current screen mode. >>TURTLEMODE outputs the word WRAP, FENCE, or WINDOW depending on the current turtle mode. >>LABELSIZE (wxWidgets only) outputs a list of two positive integers, the width and height of characters displayed by LABEL measured in turtle steps (which will be different from screen pixels if SETSCRUNCH has been used). There is no SETLABELSIZE because the width and height of a font are not separately controllable, so the inverse of this operation is SETLABELHEIGHT, which takes just one number for the desired height. **PEN AND BACKGROUND CONTROL >>The turtle carries a pen that can draw pictures. At any time the pen can be UP (in which case moving the turtle does not change what's on the graphics screen) or DOWN (in which case the turtle leaves a trace). If the pen is down, it can operate in one of three modes: PAINT (so that it draws lines when the turtle moves), ERASE (so that it erases any lines that might have been drawn on or through that path earlier), or REVERSE (so that it inverts the status of each point along the turtle's path). >>PENDOWN/PD sets the pen's position to DOWN, without changing its mode. >>PENUP/PU sets the pen's position to UP, without changing its mode. >>PENPAINT/PPT sets the pen's position to DOWN and mode to PAINT. >>PENERASE/PE sets the pen's position to DOWN and mode to ERASE. >>PENREVERSE/PX sets the pen's position to DOWN and mode to REVERSE. (This may interact in system-dependent ways with use of color.) >>SETPENCOLOR/SETPC colornumber.or.rgblist sets the pen color to the given number, which must be a nonnegative integer. There are initial assignments for the first 16 colors: 0 black 1 blue 2 green 3 cyan 4 red 5 magenta 6 yellow 7 white 8 brown 9 tan 10 forest 11 aqua 12 salmon 13 purple 14 orange 15 grey but other colors can be assigned to numbers by the PALETTE command. Alternatively, sets the pen color to the given RGB values (a list of three nonnegative numbers less than 100 specifying the percent saturation of red, green, and blue in the desired color). >>SETPALETTE colornumber rgblist sets the actual color corresponding to a given number, if allowed by the hardware and operating system. Colornumber must be an integer greater than or equal to 8. (Logo tries to keep the first 8 colors constant.) The second input is a list of three nonnegative numbers less than 100 specifying the percent saturation of red, green, and blue in the desired color. >>SETPENSIZE size sets the thickness of the pen. The input is either a single positive integer or a list of two positive integers (for horizontal and vertical thickness). Some versions pay no attention to the second number, but always have a square pen. >>SETPENPATTERN pattern sets hardware-dependent pen characteristics. This command is not guaranteed compatible between implementations on different machines. >>SETPEN list (library procedure) sets the pen's position, mode, thickness, and hardware-dependent characteristics according to the information in the input list, which should be taken from an earlier invocation of PEN. >>SETBACKGROUND/SETBG colornumber.or.rgblist set the screen background color by slot number or RGB values. See SETPENCOLOR for details. **PEN QUERIES >>PENDOWNP/PENDOWN? outputs TRUE if the pen is down, FALSE if it's up. >>PENMODE outputs one of the words PAINT, ERASE, or REVERSE according to the current pen mode. >>PENCOLOR/PC outputs a color number, a nonnegative integer that is associated with a particular color, or a list of RGB values if such a list was used as the most recent input to SETPENCOLOR. There are initial assignments for the first 16 colors: 0 black 1 blue 2 green 3 cyan 4 red 5 magenta 6 yellow 7 white 8 brown 9 tan 10 forest 11 aqua 12 salmon 13 purple 14 orange 15 grey but other colors can be assigned to numbers by the PALETTE command. >>PALETTE colornumber outputs a list of three nonnegative numbers less than 100 specifying the percent saturation of red, green, and blue in the color associated with the given number. >>PENSIZE outputs a list of two positive integers, specifying the horizontal and vertical thickness of the turtle pen. (In some implementations, including wxWidgets, the two numbers are always equal.) >>PENPATTERN outputs system-specific pen information. >>PEN (library procedure) outputs a list containing the pen's position, mode, thickness, and hardware-specific characteristics, for use by SETPEN. >>BACKGROUND/BG outputs the graphics background color, either as a slot number or as an RGB list, whichever way it was set. (See PENCOLOR.) End>QBT006.sb< Start>QBZ392.sb< '----------------------------------------------------------------------------------------------------------- '--------------------------Armored Assault--------------------------------------------------------------- '--------------------------Developed By ---------------------------------------------------------------- '--------------------------Sean Sullivan----------------------------------------------------------------- '===========Copyright DOSMANN INC.================================= '-----------------------Started Jan, 2014---------------------------------------------------------------- '------------------------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------------------------ GraphicsWindow.Height = 100 GraphicsWindow.Width = 300 GraphicsWindow.BrushColor = "Black" GraphicsWindow.Title = "" LDUtilities.Icon = Program.Directory + "/Icon.ico" GraphicsWindow.DrawText(70,20,"Enter the server name:") TxtBox = Controls.AddTextBox(65,40) B = Controls.AddButton("Host",125,65) Controls.ButtonClicked = OnButtonClicked Sub OnButtonClicked Data = LDNetwork.GetGameData("TankWarsBeta") NumofServers = LDNetwork.GetGameData("TankWarsBetaNum") Servers = LDNetwork.GetGameData("TankWarsServers") For t = 1 To 20 If Servers[t] = "open" Then 'TextWindow.WriteLine("Server " + t + " is open") Server2Host = t Servers[t] = "closed" Goto Escape EndIf EndFor Escape: LDNetwork.SetGameData("TankWarsServers",Servers) Data[Server2Host]["Server"] = Controls.GetTextBoxText(TxtBox) Data[Server2Host]["Port"] = 14567 Server = IOTCPServer.StartServer(14567) Data[Server2Host]["IP"] = IOTCPServer.IP CanStartgame = "Yes" EndSub While CanStartgame <> "Yes" Program.Delay(50) EndWhile GraphicsWindow.Clear() GraphicsWindow.Width = 781 GraphicsWindow.Height = 600 GraphicsWindow.MouseMove = OnMouseMove GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GraphicsWindow.MouseDown = TankSelection LDUtilities.ShowErrors = "False" LDUtilities.ExitOnClose = "False" LDUtilities.GWClosing = OnGWClose LDShapes.AnimationInterval = 40 Img = ImageList.LoadImage(Program.Directory + "/Sand.png") For i10 = 1 to 2000 Step 1000 For i11 = 1 To 2000 Step 500 ' Shapes.Move(Shapes.AddImage(Img),i10,i11) GraphicsWindow.DrawImage(Img,i10,i11) EndFor EndFor 'GraphicsWindow.KeyDown = OnKeyDown CurrentMap = "JunkYardOfDeath" 'Coo DefineLevels() SetupLevel() Mouse.HideCursor() MouseCursorDir = Program.Directory + "\crosshair.png" MouseCursor = Shapes.AddImage(MouseCursorDir) ' The following line could be harmful and has been automatically commented. ' Username[1] = LDEncryption.AESDecrypt(File.ReadLine(Program.Directory + "/Settings.txt",1),"TankWars") SpawnTime = 5 NumOfPlayers = 1 MaxSpeed = 15 AccelerationInc = 0.020 DecelerationInc = 0.02'0050 TurningSpeed = 3 BallCount = 10 Delta = 1 power = 20 Gravity = 0 '<--- Change this to 1500 to use it well PlayerNum = 1 TankHealthInit = 100 wkey = 0 skey = 0 dkey = 0 akey = 0 Firelast = Clock.ElapsedMilliseconds Progdir = Program.Directory + "\" TankWeapon = LDNetwork.GetGameData("TankWarsWeapons") SecectorCircle = Shapes.AddImage(Progdir + "Select.png") Shapes.Move(SecectorCircle,5000,5000) For w = 1 to BallCount Var = LDNetwork.GetGameData("TankWars" + Username[1]) CurrentProj[1] = Var["weapon"] Exp[1][w] = LDShapes.AddAnimatedImage(Progdir + TankWeapon[CurrentProj[1]]["Animation"],"False",TankWeapon[CurrentProj[1]]["AnimCountx"],TankWeapon[CurrentProj[1]]["AnimCounty"]) LDShapes.AnimationSet(Exp[1][w],16) EndFor For q = 1 To NumOfPlayers Tankx[q] = TankInitPos[q]["x"] Tanky[q] = TankInitPos[q]["y"] UsernameText[q] = Shapes.AddText(Username[q]) TankExp[q] = LDShapes.AddAnimatedImage(Program.Directory + "/Animations/anim1.png","False",8,6) LDShapes.AnimationSet(TankExp[q],48) TankHealth[q] = TankHealthInit Var = LDNetwork.GetGameData("TankWars" + Username[1]) CurrentProj[q] = Var["weapon"] Tank[q] = Shapes.AddImage(Program.Directory + "/Tank.png") Turret[q] = Shapes.AddImage(Program.Directory + "/" + TankWeapon[CurrentProj[q]]["Turret"]) ScoreText[q] = Shapes.AddText("") Endfor LDScrollBars.Add(1680,1200) LDScrollBars.Visibility = "False" If Server = "SUCCESS" Then SentData = LDNetwork.SetGameData("TankWarsBeta",Data) LDNetwork.SetGameData("TankWarsBetaNum",NumofServers + 1) EndIf IOTCPServer.OnClientConnect = OnClientConnect IOTCPServer.OnMessageRecieved = OMR 'Timer.Tick = MainLoop 'Timer.Interval = 10 While 1 = 1 Program.Delay(20) GraphicsWindow.Title = "You are at " + TankHealth[1] + " Health" If Tanky[1] < 4000 Then LDScrollBars.VerticalScroll = Tanky[1] - 300 LDScrollBars.HorizontalScroll = Tankx[1] - 400 EndIf For q = 1 To NumOfPlayers Shapes.Move(UsernameText[q],Tankx[q],Tanky[q] - 15) ' Shapes.Move(ScoreText[q],10,10*q) ' Shapes.SetText(ScoreText[q], Username[q] + ": " + Score[q]) If TankDead[q] = "True" Then If (Clock.ElapsedMilliseconds - TankDieat) > (SpawnTime *1000) Then TankDead[q] = "False" Tankx[q] = TankInitPos[q]["x"] Tanky[q] = TankInitPos[q]["y"] TankHealth[q] = TankHealthInit EndIf EndIf If TankDead[1] = "True" Then If q = 1 Then Shapes.Move(Tank[q],Tankx[q],Tanky[q]) Shapes.Move(Turret[q],Tankx[q] + 6,Tanky[q] - 28) MoveBalls() CheckBulletColision() Goto Skip EndIf EndIf Shapes.Move(Tank[q],Tankx[q],Tanky[q]) Shapes.Move(Turret[q],Tankx[q] + 6,Tanky[q] - 28) If SelectedTank <> "" Then Shapes.Move(SecectorCircle,Tankx[SelectedTank] - 15,Tanky[SelectedTank] - 10) Endif Shapes.Rotate(Tank[q],Angle[q] + 90) MoveBalls() GetTurretAngle() RotateTurret() SetTime() GetAngle() GetTankpos() CheckColision() If Username[q] <> "" Then CheckBulletColision() EndIf Skip: EndFor If Mouse.IsLeftButtonDown Then OnMouseDown() EndIf EndWhile '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++SUBROUTINES+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub SetTime Time = Time + Dtime[q] If q = 1 Then '<--------------------------------------V If LDUtilities.KeyDown("w") Then If Dtime[q] < .002 Then Dtime[q] = Dtime[q] + AccelerationInc EndIf EndIf If LDUtilities.KeyDown("w") <> "True" Then If Dtime[q] > 0 Then Dtime[q] = Dtime[q] - DecelerationInc EndIf EndIf If LDUtilities.KeyDown("s") Then If Dtime[q] > -0.001 Then Dtime[q] = Dtime[q] - (AccelerationInc / 2) EndIf EndIf If LDUtilities.KeyDown("s") <> "True" Then If Dtime[q] < 0 Then Dtime[q] = Dtime[q] + DecelerationInc EndIf EndIf Else '<------------------------------------------------------^ If ClientKey[q]["w"] = "Down" Then If Dtime[q] < .002 Then Dtime[q] = Dtime[q] + AccelerationInc EndIf EndIf If ClientKey[q]["w"] = "Up" Then If Dtime[q] > 0 Then Dtime[q] = Dtime[q] - DecelerationInc EndIf EndIf If ClientKey[q]["s"] = "Down" Then If Dtime[q] > -0.001 Then Dtime[q] = Dtime[q] - (AccelerationInc / 2) EndIf EndIf If ClientKey[q]["s"] = "Up" Then If Dtime[q] < 0 Then Dtime[q] = Dtime[q] + DecelerationInc EndIf EndIf EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub OnMouseMove Mx = GraphicsWindow.MouseX My = GraphicsWindow.Mousey Shapes.Move(MouseCursor,Mx - 15,My - 15) '<-- No Idea why it is 15 not 30, but it works EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub SetupLevel For Levx = 1 To Text.GetLength(Level[1][1]) For Levy = 1 To 40 If Text.GetSubText(Level[1][Levy],Levx,1) = "p" Then Shapes.Move(Shapes.AddImage(Program.Directory + "/Brick.Png"),Levx * 30 - 30,Levy * 30 - 30) EndIf If LDUtilities.IsNumber(Text.GetSubText(Level[1][Levy],Levx,1)) Then TankInitPos[Text.GetSubText(Level[1][Levy],Levx,1)]["x"] = Levx * 30 - 30 TankInitPos[Text.GetSubText(Level[1][Levy],Levx,1)]["y"] = Levy * 30 - 30 EndIf EndFor EndFor EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub DefineLevels LevelPath = Program.Directory + "/Levels/" + CurrentMap + ".txt" For ly = 1 To 40 ' The following line could be harmful and has been automatically commented. ' Level[1][ly] = File.ReadLine(LevelPath,ly) EndFor EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub GetAngle If q = 1 Then If LDUtilities.KeyDown("a") Then Angle[q] = Angle[q] - TurningSpeed ElseIf LDUtilities.KeyDown("d") Then Angle[q] = Angle[q] + TurningSpeed EndIf Else If ClientKey[q]["a"] = "Down" Then Angle[q] = Angle[q] - TurningSpeed ElseIf ClientKey[q]["d"] = "Down" Then Angle[q] = Angle[q] + TurningSpeed EndIf EndIf If Angle[q] >= 360 Then Angle[q] = 0 EndIf If Angle[q] < 0 Then Angle[q] = 359 - Angle[q] EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckColision RealDtime[q] = Dtime[q] RealAngle = Angle[q] Time = Time + Dtime[q] If q = 1 Then If LDUtilities.KeyDown("w") Then If Dtime[q] < .002 Then Dtime[q] = Dtime[q] + AccelerationInc EndIf EndIf If LDUtilities.KeyDown("w") <> "True" Then If Dtime[q] > 0 Then Dtime[q] = Dtime[q] - DecelerationInc EndIf EndIf Else If ClientKey[q]["w"] = "Down" Then If Dtime[q] < .002 Then Dtime[q] = Dtime[q] + AccelerationInc EndIf EndIf If clientKey[q]["w"] = "Up" Then If Dtime[q] > 0 Then Dtime[q] = Dtime[q] - DecelerationInc EndIf EndIf EndIf Array2 = Zock77Math.Fire(Tankx[q],Tanky[q],0,Time,MaxSpeed,Angle[q]) TankxCheck[q] = Array2["x"] TankyCheck[q] = Array2["y"] TankRoundx = Math.Round((TankxCheck[q] - 15) / 30 + 1) TankRoundy = Math.Round((TankyCheck[q] - 15) / 30 + 1) TankxCheck2[q] = Array2["x"] + 35 TankyCheck2[q] = Array2["y"] + 35 TankRoundx2 = Math.Round((TankxCheck2[q] - 15) / 30 + 1) TankRoundy2 = Math.Round((TankyCheck2[q] - 15) / 30 + 1) Result = Text.GetSubText(Level[1][TankRoundy],TankRoundx,1) Result2 = Text.GetSubText(Level[1][TankRoundy2],TankRoundx2,1) If Result = "p" Or Result2 = "p" Then Angle[q] = Zock77Math.RoundtoNearest(Angle[q],90) Dtime[q] = 0 Else Dtime[q] = RealDtime[q] EndIf Time = 0 EndSub ' '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Fire ShotsFired[FiringTank] = ShotsFired[FiringTank] + Delta If Ball[FiringTank][ShotsFired[FiringTank]] = "" Then '<--- If it has not already spawned, then add it If TankWeapon[CurrentProj[FiringTank]]["ProjectileAnix"] = 1 And TankWeapon[CurrentProj[FiringTank]]["ProjectileAniy"] =1 Then Ball[FiringTank][ShotsFired[FiringTank]] = Shapes.AddImage(Progdir + TankWeapon[CurrentProj[FiringTank]]["Projectile"]) Else Ball[FiringTank][ShotsFired[FiringTank]] = LDShapes.AddAnimatedImage(Progdir + TankWeapon[CurrentProj[FiringTank]]["Projectile"],"True",TankWeapon[CurrentProj[FiringTank]]["ProjectileAnix"],TankWeapon[CurrentProj[FiringTank]]["ProjectileAniy"]) EndIf EndIf If ShotsFired[FiringTank] > BallCount Then '<--- If the number of shots fired is more than the number of balls that can possible be on the screen, Then set it to One ShotsFired[FiringTank] = 1 EndIf Missile_Dead[FiringTank][ShotsFired[FiringTank]] = "False" If TankWeapon[CurrentProj[FiringTank]]["Homeing"] = "True" Then vx[FiringTank][ShotsFired[FiringTank]] = Math.GetDegrees(Math.Cos(Math.GetRadians(TurretAngle[FiringTank] - 90))) * (TankWeapon[CurrentProj[FiringTank]]["Velocity"] / 750) vy[FiringTank][ShotsFired[FiringTank]] = Math.GetDegrees(Math.Sin(Math.GetRadians(TurretAngle[FiringTank] - 90))) * (TankWeapon[CurrentProj[FiringTank]]["Velocity"] / 750) Missilex[FiringTank][ShotsFired[FiringTank]]=FireTankx Missiley[FiringTank][ShotsFired[FiringTank]]=FireTanky Tankat[FiringTank][ShotsFired[FiringTank]]=TankSelected[FiringTank] Else Startx[FiringTank][ShotsFired[FiringTank]] = FireTankx Starty[FiringTank][ShotsFired[FiringTank]] = FireTanky AngleFire[FiringTank][ShotsFired[FiringTank]] = TurretAngle[FiringTank]'<--- Set the Firing Angle TimeStart[FiringTank][ShotsFired[FiringTank]] = Clock.ElapsedMilliseconds / 1000 EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub GetTurretAngle AngleRad = Math.ArcTan((GraphicsWindow.MouseY - Tanky[1]) / (GraphicsWindow.MouseX - TankX[1])) TurretAngle[1] = Math.GetDegrees(AngleRad) + 90 If (GraphicsWindow.MouseX - TankX[1]) = 0 or (GraphicsWindow.MouseX - TankX[1]) < 0 Then TurretAngle[1] = TurretAngle[1] - 180 EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub MoveBalls For i = 1 To BallCount If Missile_Dead[q][i] = "True" Then Shapes.Move(ball[q][i],6000,6000) TimeStart[q][i] = TimeStart[q][i] - 500 '<--- Fixes non-homing Missilex[q][i]= 6000 '<--- Fixes homing Missiley[q][i]=6000 '<--- Fixes homing Else If TankWeapon[CurrentProj[q]]["Homeing"] = "True" Then '=================================================================HOMEING STUFF Missile_speed = TankWeapon[CurrentProj[q]]["Velocity"] / 10 If Tankat[q][i] <> "" And Tankx[Tankat[q][i]] < GraphicsWindow.Width And Tanky[Tankat[q][i]] < GraphicsWindow.Height Then Missile_turning = TankWeapon[CurrentProj[q]]["TurnRate"] Targetx =Tankx[Tankat[q][i]] Targety = Tanky[Tankat[q][i]] dx[q][i]=Targetx-Missilex[q][i] dy[q][i]=Targety-Missiley[q][i] distance[q][i]=Math.SquareRoot((dx[q][i]*dx[q][i])+(dy[q][i]*dy[q][i])) dx[q][i]=dx[q][i]/distance[q][i] dy[q][i]=dy[q][i]/distance[q][i] vx[q][i]=vx[q][i]+(dx[q][i]*Missile_turning) vy[q][i]=vy[q][i]+(dy[q][i]*Missile_turning) velocity[q][i]=Math.SquareRoot((vx[q][i]*vx[q][i])+(vy[q][i]*vy[q][i])) if (velocity[q][i]>Missile_speed) Then vx[q][i]=(vx[q][i]*Missile_speed)/velocity[q][i] vy[q][i]=(vy[q][i]*Missile_speed)/velocity[q][i] EndIf EndIf Missilex[q][i]=Missilex[q][i]+vx[q][i] Missiley[q][i]=Missiley[q][i]+vy[q][i] Offsety = TankWeapon[CurrentProj[q]]["ProjectileOffsety"] Offsetx = TankWeapon[CurrentProj[q]]["ProjectileOffsetx"] Shapes.Move(ball[q][i],Missilex[q][i] + Offsetx,Missiley[q][i] + Offsety) Xchange = Missilex[q][i] - OldX[q][i] Ychange = Missiley[q][i] - OldY[q][i] If Xchange < 0 Then Rot = Math.GetDegrees(Math.ArcTan(Ychange/Xchange)) - 180 Else Rot = Math.GetDegrees(Math.ArcTan(Ychange/Xchange)) EndIf Shapes.Rotate(Ball[q][i],rot) OldY[q][i] = Missiley[q][i] OldX[q][i] = Missilex[q][i] Else '<-----------------------------------------------------------------V---Not homeing TimeFire[q][i] = (Clock.ElapsedMilliseconds / 1000) - TimeStart[q][i] Firestart = Zock77Math.GetCircle(25,Startx[q][i] + 12,Starty[q][i] + 20,AngleFire[q][i] - 90) xyArray = Zock77Math.Fire(Firestart["x"],Firestart["y"],Gravity,TimeFire[q][i],TankWeapon[CurrentProj[q]]["Velocity"],AngleFire[q][i] - 90) Offsety = TankWeapon[CurrentProj[q]]["ProjectileOffsety"] Offsetx = TankWeapon[CurrentProj[q]]["ProjectileOffsetx"] Shapes.Move(Ball[q][i],xyArray["x"]+ Offsetx,xyArray["y"] + Offsety) Xchange = xyArray["x"] - OldX[q][i] Ychange = xyArray["y"] - OldY[q][i] If Xchange < 0 Then Rot = Math.GetDegrees(Math.ArcTan(Ychange/Xchange)) - 180 Else Rot = Math.GetDegrees(Math.ArcTan(Ychange/Xchange)) EndIf Shapes.Rotate(Ball[q][i],rot) OldY[q][i] = xyArray["y"] OldX[q][i] = xyArray["x"] EndIf EndIf EndFor EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub RotateTurret Shapes.Rotate(Turret[q], TurretAngle[q]) EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub GetTankpos Array = Zock77Math.Fire(Tankx[q],Tanky[q],0,Time,MaxSpeed,Angle[q]) Tankx[q] = Array["x"] Tanky[q] = Array["y"] Time = 0 EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Occ EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub OnClientConnect ' For w = 1 To NumClients 'TextWindow.WriteLine(IOTCPServer.LastClientConnectIP) ' TextWindow.WriteLine(ClientIP[w]) ' If IOTCPServer.LastClientConnectIP = ClientIP[w] Then '<--- if the client has allready connected before then ' TextWindow.WriteLine("Client has allready connected") ' For p = 1 To NumClients ' Var1 = Var1 + ";username" +p+ "=" + Username[p] ' EndFor ' IOTCPServer.SendMessage("You are client number " + w + " " + "level=" + CurrentMap + Var1 + ";",ClientIP[w]) ' For i3 = w To NumClients - 1 ' IOTCPServer.SendMessage("Client Connect " + ClientIP[w] ,ClientIP[i3]) ' EndFor 'EndIf 'Goto Skip2 'EndFor NumClients = NumClients + 1 ClientNum[IOTCPServer.LastClientConnectIP] = NumClients ClientIP[NumClients] = IOTCPServer.LastClientConnectIP NumOfPlayers = NumOfPlayers + 1 ScoreText[NumOfPlayers] = Shapes.AddText("") Username[NumOfPlayers] = LDNetwork.GetGameData("TankWars" + ClientIP[NumClients]) 'TextWindow.WriteLine("Username = " + Username[NumOfPlayers]) DataUser = LDNetwork.GetGameData("TankWars" + Username[NumOfPlayers]) CurrentProj[NumOfPlayers] = DataUser["weapon"] Nop = NumOfPlayers Var = NumClients + 1 For p = 1 To Var - 1 Var1 = Var1 + ";username" +p+ "=" + Username[p] EndFor 'extWindow.WriteLine(Var1) IOTCPServer.SendMessage("You are client number " + Var + " " + "level=" + CurrentMap + Var1 + ";",IOTCPServer.LastClientConnectIP) For i3 = 1 To NumClients - 1 IOTCPServer.SendMessage("Client Connect " + ClientIP[NumClients] ,ClientIP[i3]) EndFor Tankx[Nop] = TankInitPos[Nop]["x"] Tanky[Nop] = TankInitPos[Nop]["y"] UsernameText[Nop] = Shapes.AddText(Username[Nop]) Tank[Nop] = Shapes.AddImage(Program.Directory + "/Tank.png") Turret[Nop] = Shapes.AddImage(Program.Directory + "/" + TankWeapon[CurrentProj[Nop]]["Turret"]) TankHealth[Nop] = TankHealthInit TankExp[Nop] = LDShapes.AddAnimatedImage(Program.Directory + "/Animations/anim1.png","False",8,6) LDShapes.AnimationSet(TankExp[Nop],48) For w22 = 1 to BallCount Exp[nop][w22] = LDShapes.AddAnimatedImage(Progdir + TankWeapon[CurrentProj[Nop]]["Animation"],"False",TankWeapon[CurrentProj[Nop]]["AnimCountx"],TankWeapon[CurrentProj[Nop]]["AnimCounty"]) LDShapes.AnimationSet(Exp[Nop][w22],16) EndFor skip2: EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Omr k = ClientNum[IOTCPServer.LastMessageIP] + 1 Data = IOTCPServer.LastMessageData For f = 1 To NumClients IOTCPServer.SendMessage(Data,ClientIP[f]) EndFor Var = Data If TankDead[Var["client"]] <> "True" Then If Var["type"] = "pos" Then k = Var["client"] KeyClient = Var["key"] Tankx[k] = Var["x"] Tanky[k] = Var["y"] Angle[k] = Var["ang"] Dtime[k] = Var["dtime"] Array1 = "0=Up;1=Down;" Array2 = "1=w;2=d;3=s;4=a;" 'here I'm translateing the input 'The format is sends is like such: 0010 'the four digits reprsent the four keys. wdsa (in that order) 0 is up, 1 is down. For i4 = 1 To 4 KeyVar[Array2[i4]] = Array1[Text.GetSubText(KeyClient,i4,1)] ClientKey[k][Array2[i4]] = KeyVar[Array2[i4]] EndFor EndIf If Var["type"] = "fire" Then FiringTank = Var["client"] FireTankx = Var["x"] FireTanky = Var["y"] TurretAngle[FiringTank] = Var["ang"] TankSelected[FiringTank] = Var["ts"] Distx = Math.Abs(Tankx[Var["client"]] - FireTankx) Disty = Math.Abs(Tanky[Var["client"]] - FireTanky) ' If the tank is too far off, then fix its position If Distx > 25 Then Tankx[Var["client"]] = FireTankx EndIf If Disty > 25 Then Tanky[Var["client"]] = FireTanky EndIf Fire() EndIf EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub OnKeyDown Key = GraphicsWindow.LastKey If Key <> OldKey Then Info = "KEYDO " + Key SendInfo() EndIf OldKey = Key KeyUp = "" EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub OnKeyUp If GraphicsWindow.LastKey <> KeyUp Then KeyUp = GraphicsWindow.LastKey OldKey = "" Info = "KEYUP " + KeyUp SendInfo() EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub SendInfo 'The format is sends is like such: 0010 'the four digits reprsent the four keys. wdsa (in that order) 0 is up, 1 is down. If Info = "KEYDO W" Then wkey = 1 ElseIf Info = "KEYUP W" Then wkey = 0 ElseIf Info = "KEYDO D" Then dkey = 1 ElseIf Info = "KEYUP D" Then dkey = 0 ElseIf Info = "KEYDO S" Then skey = 1 ElseIf Info = "KEYUP S" Then skey = 0 ElseIf Info = "KEYDO A" Then akey = 1 ElseIf Info = "KEYUP A" Then akey = 0 EndIf DatatoSend = Text.Append(wkey,dkey) DatatoSend = Text.Append(DatatoSend,skey) DatatoSend = Text.Append(DatatoSend,akey) For i2 = 1 To NumClients ' IOTCPServer.SendMessage("1=" + Info + ";",ClientIP[i2]) Var = "type=pos;x=" + Math.Round(Tankx[1]) + ";y=" + Math.Round(Tanky[1]) + ";ang=" + Math.Round(Angle[1]) + ";key=" + DatatoSend + ";client=1" + ";dtime=" + Dtime[1] IOTCPServer.SendMessage(Var,ClientIP[i2]) 'TextWindow.WriteLine(Var) EndFor EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub OnGWClose Servers = LDNetwork.GetGameData("TankWarsServers") Servers[Server2Host] = "open" LDNetwork.SetGameData("TankWarsServers",Servers) LDProcess.Start(Program.Directory + "/Armored Assault.exe","") Program.End() EndSub Sub OnMouseDown If Clock.ElapsedMilliseconds - Firelast > TankWeapon[CurrentProj[1]]["ROF"] Then FiringTank = 1 FireTankx = Tankx[1] FireTanky = Tanky[1] TankSelected[1] = SelectedTank Fire() For i2 = 1 To NumClients Var = "type=fire;x=" + Math.Round(Tankx[1]) + ";y=" + Math.Round(Tanky[1]) + ";ang=" + Math.Round(TurretAngle[1]) + ";client=1" + ";ts=" + SelectedTank IOTCPServer.SendMessage(Var,ClientIP[i2]) EndFor Firelast = Clock.ElapsedMilliseconds EndIf EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub CheckBulletColision For i = 1 To BallCount If TankWeapon[CurrentProj[q]]["Homeing"] = "True" Then tempX = Missilex[q][i] tempY = Missiley[q][i] TankRoundx = Math.Round((tempX - 15) / 30 + 1) TankRoundy = Math.Round((tempY - 15) / 30 + 1) Result = Text.GetSubText(Level[1][TankRoundy],TankRoundx,1) Else TimeFire[q][i] = (Clock.ElapsedMilliseconds / 1000) - TimeStart[q][i] Firestart = Zock77Math.GetCircle(25,Startx[q][i] + 12,Starty[q][i] + 20,AngleFire[q][i] - 90) xyArray5 = Zock77Math.Fire(Firestart["x"],Firestart["y"],Gravity,TimeFire[q][i],TankWeapon[CurrentProj[q]]["Velocity"],AngleFire[q][i] - 90) TankRoundx = Math.Round((xyArray5["x"] - 15) / 30 + 1) TankRoundy = Math.Round((xyArray5["y"] - 15) / 30 + 1) Result = Text.GetSubText(Level[1][TankRoundy],TankRoundx,1) tempX = xyArray5["x"] tempY = xyArray5["y"] EndIf For t1 = 1 To NumOfPlayers If q <> t1 Then If tempX > Tankx[t1] And tempX < Tankx[t1] + 30 And tempY > Tanky[t1] And tempY < TankY[t1] + 30 Then TankHealth[t1] = TankHealth[t1] - TankWeapon[CurrentProj[q]]["Damage"] If TankHealth[t1] <= 0 Then For i2 = 1 To NumClients Var = "type=death;client=" + t1 Score[t1] = Score[t1] + 1 IOTCPServer.SendMessage(Var,ClientIP[i2]) EndFor TankDead[t1] = "True" StartSpawncount() Shapes.Move(TankExp[t1],Tankx[t1]-49,Tanky[t1]-49) Shapes.Rotate(TankExp[t1], Angle[t1] + 90) LDShapes.AnimationSet(TankExp[t1],1) GraphicsWindow.DrawImage(Program.Directory + "/scorch_mark" + Math.Round(Math.GetRandomNumber(2)) +".png",Tankx[t1]-49,Tanky[t1]-49) 'Shapes.Move(Shapes.AddImage(Program.Directory + "/scorch_mark" + Math.Round(Math.GetRandomNumber(2)) +".png"),Tankx[t1]-49,Tanky[t1]-49) Tankx[t1] = 5000 Tanky[t1] = 5000 EndIf Missile_Dead[q][i] = "True" EndIf EndIf EndFor If Result = "p" Then Missile_Dead[q][i] = "True" Shapes.Move(Exp[q][i], tempX - 34,tempY - 32) Shapes.Rotate(Exp[q][i], Math.GetRandomNumber(360)) LDShapes.AnimationSet(Exp[q][i],1) EndIf EndFor EndSub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub TankSelection If Mouse.IsRightButtonDown Then Mx = GraphicsWindow.MouseX My = GraphicsWindow.MouseY For u2 = 1 To NumOfPlayers Var = LDShapes.GetAllShapesAt(Mx,My) For u3 = 1 to Array.GetItemCount(Var) If Var[u3] = Tank[u2] Then SelectedTank = u2 u2 = NumOfPlayers '<-- exit the For statement EndIf EndFor EndFor EndIf EndSub Sub StartSpawncount TankDieat = Clock.ElapsedMilliseconds EndSub End>QBZ392.sb< Start>QCB523.sb< GraphicsWindow.DrawEllipse (1,1,1,1) bgg= LDShapes.BrushGradient ("1=blue;2=black;","V") ldGraphicsWindow.BackgroundBrushGradient (bgg) GraphicsWindow.DrawImage ( Clipboard.GetImage(),300,20) For x=1 To 12 dy= LDMath.Sin((x+6)*30)*20 dx=LDMath.cos((x+6)*30)*60 GraphicsWindow.BrushColor=LDColours.HSLtoRGB(30,0.8,0.4+x*5/200) GraphicsWindow.FillEllipse (550+dx,450+dy,50,100) EndFor GraphicsWindow.Title="Happy Halloween GraphicsWindow.Width =1100 GraphicsWindow.Height=950 GraphicsWindow.top=10 GraphicsWindow.Left=10 GraphicsWindow.BrushColor="Yellow mm[1]="287,267; 306,272; 308,282; 316,276; 325,272; 333,273; 335,280; 343,280; 349,271; 357,270; 368,265; 373,266; 374,268; 362,276; 353,283; 344,291; 339,289; 332,287; 326,287; 318,289; 311,291; 305,286; 299,284; 294,278; mm[2]="296,201; 312,192; 318,174; 325,157; 347,156; 326,188; 337,194; 343,198; mm[3]="322,34; 346,55; 361,58; 367,76; 377,83; 384,72; 388,79; 396,72; 395,87; 404,88; 419,76; 437,78; 461,62; 452,94; 444,93; 438,98; 436,104; 424,103; 414,107; 411,113; 403,104; 392,104; 385,106; 379,116; 377,100; 368,96; 360,99; 358,92; 348,88; 336,86; 337,77; 325,62; mm[4]="634,431; 620,361; 639,337; 646,296; 697,259; 643,291; 631,333; 613,358; 613,316; 598,284; 602,346; 554,301; 553,280; 567,248; 548,274; 514,261; 541,278; 506,293; 542,283; 543,294; 549,303; 600,355; 604,377; 592,382; 553,347; 542,323; 536,298; 539,347; 509,358; 541,350; 588,387; 604,426; mm[5]="490,435; 494,373; 507,375; 486,319; 493,293; 472,313; 446,331; 445,298; 456,287; 443,270; 432,282; 423,288; 427,261; 438,255; 406,215; 376,260; 389,261; 390,331; 375,330; 346,286; 334,333; 307,374; 327,374; 329,450; 411,448; mm[6]="726,430; 690,336; 674,330; 726,292; 725,268; 703,263; 755,221; 804,260; 791,258; 789,289; 831,309; 815,319; 790,417; mm[7]="290,579; 259,635; 300,650; 329,596; 362,607; 337,610; 288,705; 295,720; 275,711; 289,658; 253,649; 220,692; 185,677; 209,674; 264,582; mm[8]="386,611; 425,615; 414,624; 387,748; 361,744; 395,627; 344,667; 370,676; 336,679; 318,728; 304,724; 319,657; 383,616; mm[9]="445,619; 474,623; 425,753; 482,756; 475,771; 406,760; 451,630; mm[10]="455,605; 459,589; 527,603; 486,735; 462,744; 505,609; 456,607; mm[11]="564,644; 526,667; 512,705; 492,756; 509,780; 535,783; 556,779; 583,736; 600,691; 607,658; 596,645; 582,648; 588,673; 575,715; 554,757; 525,771; 506,757; 520,723; 535,689; 549,670; 554,684; 541,707; 553,711; 560,704; 574,675; 567,649; mm[12]="616,642; 641,644; 616,771; 661,696; 655,776; 695,649; 736,644; 706,656; 661,813; 645,762; 598,818; 616,654; mm[13]="720,675; 810,680; 734,694; 717,734; 753,747; 714,753; 703,797; 744,833; 687,809; 696,741; 705,735; 698,719; 717,684; mm[14]="769,705; 820,699; 793,766; 746,767; 776,786; 772,828; 740,847; 785,837; 792,780; 835,698; 815,681; mm[15]="853,694; 805,846; 819,843; 854,721; 889,850; 947,669; 888,788; 856,654; 833,666; 846,675; For f=1 to 15 mms= LDText.Split (mm[f],";") pp="" For r=1 to Array.GetItemCount (mm[f])*2 ll= LDText.Split (mms[r],",") pp[r][1]=ll[1] pp[r][2]=ll[2] endfor ppg[f]=LDShapes.AddPolygon (pp) endfor Shapes.Zoom(ppg[2],0.8,0.7) Shapes.Zoom(ppg[4],1.4,1.6) Shapes.Move (ppg[6],120,40) Shapes.Move (ppg[1],250,250) Shapes.Move (ppg[2],290,295) ldShapes.BrushColour (ppg[2],"Green") ddx=250 sx=300+ddx sy=240+ddx GraphicsWindow.FillTriangle (sx,sy,sx+15,sy+15,sx-15,sy+15) sx=350+ddx GraphicsWindow.FillTriangle (sx,sy,sx+15,sy+15,sx-15,sy+15) GraphicsWindow.PenColor="Lime GraphicsWindow.BrushColor="Black bb=Controls.AddMultiLineTextBox (10,10) Controls.HideControl (bb) ff=1 'GraphicsWindow.MouseDown=mdd lm=.5 Timer.Interval=20 Timer.Tick=tmm For g=3 to 6 LDShapes.BrushColour (ppg[g],"black") endfor Sub tmm ll= Math.GetRandomNumber (10) if ll>5 Then lm=lm+.03 ElseIf ll<5 then lm=lm-.03 EndIf If lm<0.2 Then lm=.2 ElseIf lm>.8 then lm=0.8 endif LDShapes.BrushColour (ppg[1], LDColours.HSLtoRGB (60,0.7,lm)) For x=7 To 15 LDShapes.BrushColour (ppg[x], LDColours.HSLtoRGB (60,0.6,lm)) EndFor EndSub Sub mdd tt=Controls.GetTextBoxText(bb) If ff=1 Then ox= GraphicsWindow.MouseX oy= GraphicsWindow.Mousey ff=0 endif If Mouse.IsRightButtonDown then Controls.ShowControl(bb) Controls.SetTextBoxText (bb,tt+Text.GetCharacter(13)) tt=Controls.GetTextBoxText(bb) endif Controls.SetTextBoxText (bb,tt+ GraphicsWindow.MouseX+","+ GraphicsWindow.MouseY+"; ") GraphicsWindow.DrawLine (ox,oy, GraphicsWindow.MouseX , GraphicsWindow.MouseY ) ox= GraphicsWindow.MouseX oy= GraphicsWindow.Mousey EndSub End>QCB523.sb< Start>QCC875.sb< For x = 1 To 20 y[x] = 12+3.1*x+Math.SquareRoot(x)*Math.GetRandomNumber(19)-10 EndFor sumX = 0 sumY = 0 sumX2 = 0 sumXY = 0 n = Array.GetItemCount(y) x = Array.GetAllIndices(y) For i = 1 To n sumX = sumX + x[i] sumY = sumY + y[i] sumX2 = sumX2 + x[i]*x[i] sumXY = sumXY + x[i]*y[i] EndFor a = (sumX*sumY - n*sumXY) / (sumX*sumX - n*sumX2) b = (sumY - a*sumX) / n For i = 1 To n trend[x[i]] = a*x[i]+b EndFor GraphicsWindow.Width = 500 GraphicsWindow.Height = 500 graph = LDGraph.AddGraph(0,0,500,500,"TrendLine","X","Y") LDGraph.AddSeriesPoints(graph,"Data",y,"Blue") LDGraph.AddSeriesLine(graph,"Trend",trend,"Red") End>QCC875.sb< Start>QCD342-0.sb< ' for any polygon, the area is / para cualquier polígono, el área es ' (nl^2)/(4 tan(360/2n) ) ' where / donde ' l=length of side / longitud del lado ' n=number of sides / numero de lados ' This is also a solution to the ArcTan, since Tan(x) = Tan(x+pi). TextWindow.WriteLine("number of sides / numero de lados: ") n = TextWindow.ReadNumber() TextWindow.WriteLine("length of side / longitud del lado: ") l = TextWindow.ReadNumber() lcuad = Math.Power(l, 2) dividendo = n * lcuad TextWindow.WriteLine("the dividend is / el dividendo es : " + dividendo) angulo = (360/ (2* n) + Math.Pi) TextWindow.WriteLine( "the angle is / el angulo es: " + angulo) tangente = Math.Tan(angulo) TextWindow.WriteLine(" tangent in radians / la tang en radianes es: " + tangente) divisor = 4 * tangente TextWindow.WriteLine( "the divisor is / el divisor es: " + divisor) If divisor < 0 Then divisor = divisor * (-1) Else EndIf Area = dividendo / divisor TextWindow.WriteLine( " the erea is / el area es: " + Area) TextWindow.WriteLine("") TextWindow.WriteLine("n = " + n) TextWindow.WriteLine("l = " + l) a = Math.Pi / n TextWindow.WriteLine("a = Pi/n = " + a + " (" + (a * 180 / Math.Pi) + " deg)") r = l / (2 * Math.Sin(a)) TextWindow.WriteLine("r = l/(2 sin a) = " + r) Area = n * l * r * Math.Cos(a) / 2 TextWindow.WriteLine("A = (nlr cos a)/2 = " + Area) GraphicsWindow.BackgroundColor= "Yellow" GraphicsWindow.PenColor = "Black" angulo = 360 / n For i = 1 To n Turtle.Move(l) Turtle.Turn(angulo) EndFor End>QCD342-0.sb< Start>QCD342.sb< ' para cualquier polígono, el área es ' (nl^2)/(4 tan(360/2n) ) ' donde ' l=longitud del lado ' n=numero de lados ' This is also a solution to the ArcTan, since Tan(x) = Tan(x+pi). TextWindow.WriteLine("numero de lados: ") n = TextWindow.ReadNumber() TextWindow.WriteLine("longitud del lado: ") l = TextWindow.ReadNumber() lcuad = Math.Power(l, 2) dividendo = n * lcuad TextWindow.WriteLine("el dividendo es : " + dividendo) angulo = (360/ (2* n) + Math.Pi) TextWindow.WriteLine( "el angulo es: " + angulo) tangente = Math.Tan(angulo) TextWindow.WriteLine(" la tang en radianes es: " + tangente) divisor = 4 * tangente TextWindow.WriteLine( "el divisor es: " + divisor) If divisor < 0 Then divisor = divisor * (-1) Else EndIf Area = dividendo / divisor TextWindow.WriteLine( " el area es: " + Area) Program.Delay(1000) GraphicsWindow.BackgroundColor= "Yellow" GraphicsWindow.PenColor = "Black" angulo = 360 / n For i = 1 To n Turtle.Move(l) Turtle.Turn(angulo) EndFor Program.Delay(1000) Program.End() End>QCD342.sb< Start>QCG600.sb< GraphicsWindow.Show() circ = Shapes.AddEllipse(50,50) While "True" Shapes.Animate(circ, Math.GetRandomNumber(GraphicsWindow.Width),Math.GetRandomNumber(GraphicsWindow.Height), 1000) Program.Delay(1000) EndWhile End>QCG600.sb< Start>QCH183.sb< 'Written by Thaelmann-Pioniere GraphicsWindow.Title="Molecular Challenge-Melamine(C3H6N6)" GraphicsWindow.BackgroundColor="#dabc72" GraphicsWindow.Height=Desktop.Height GraphicsWindow.Width=900 GraphicsWindow.FontBold="false" GraphicsWindow.FontName="times new roman" GraphicsWindow.BrushColor="white" GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(700,20,"C") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(740,50,"3") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(760,20,"H") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(800,50,"6") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(820,20,"N") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(860,50,"6") r=30 d=r*2 Turtle.Speed=10 Turtle.PenUp() Turtle.MoveTo(320,260) Turtle.Angle=180 Turtle.PenDown() GraphicsWindow.PenWidth=15 For i = 1 To 6 If Math.Remainder(i,2)=1 Then GraphicsWindow.BrushColor="blue" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) GraphicsWindow.PenColor="blue" Turtle.Move(r+30) GraphicsWindow.PenColor="black" Turtle.Move(30+r) x[i]=Turtle.X y[i]=Turtle.Y Turtle.Turn(-60) Else GraphicsWindow.BrushColor="black" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) GraphicsWindow.PenColor="black" Turtle.Move(r+30) GraphicsWindow.PenColor="blue" Turtle.Move(30+r) Turtle.Turn(-60) EndIf EndFor For i = 1 To 5 Step 2 Turtle.PenUp() Turtle.MoveTo(x[i],y[i]) Turtle.PenDown() Turtle.Angle=240-(i-1)*60 GraphicsWindow.PenColor="black" Turtle.Move(r+30) GraphicsWindow.PenColor="blue" Turtle.Move(30+r) GraphicsWindow.BrushColor="blue" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) direction=60 For a = 1 To 2 Turtle.PenDown() Turtle.Turn(direction) GraphicsWindow.PenColor="blue" Turtle.Move(r+30) GraphicsWindow.PenColor="white" Turtle.Move(30+r) GraphicsWindow.BrushColor="white" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) Turtle.Turn(180) Turtle.PenUp() Turtle.Move(r+60+r) EndFor EndFor Turtle.Hide() End>QCH183.sb< Start>QCK206.sb< dw=900 dh=dw GraphicsWindow.BackgroundColor ="Darkblue GraphicsWindow.Width = dw GraphicsWindow.Height = dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title ="3D fungus view3D = LD3DView.AddView(dw,dh,"True") LD3DView.AddDirectionalLight(view3D,"Pink",-1,-1,-1) LD3DView.AddDirectionalLight(view3D,"DarkBlue",1,1,1) LD3DView.AddAmbientLight(view3D,"#50111111") LD3DView.ResetCamera(view3D,0,0,170, 0,0,-1,"","","") r51=7 s3=2 For x=0 to 360-s3 step s3 tt="" For y=90 to 210 step 5 px=LDMath.Cos(x)*r51*ldmath.Sin(y-90) pz=LDMath.cos(y-90)*r51 py=LDMath.sin(y-90)*LDMath.sin(x)*r51 tt=tt+px+":"+pz+":"+py+":" endfor LD3DView.AddTube (view3D tt .5 12 LDColours.HSLtoRGB (0 .1 math.Abs(x-180)/200) "E") endfor LD3DView.TranslateGeometry (view3D LD3DView.AddCone(view3D 1.3 1.3 20 20 "gray" "D") 0, -14 0) LD3DView.AutoControl("true" "true", -1 3) fk=2 GraphicsWindow.KeyDown=kdd rott="true Sub kdd If GraphicsWindow.LastKey ="Space" Then rott="true Else rott="false EndIf EndSub While 1=1 For n=0 To 360 Step .2 deg=deg-1 x=ldMath.Sin(n)*17*fk z=ldmath.Cos(n)*17*fk If rott then LD3DView.ResetCamera(view3D,x,0,z,-x*5,20,-z*5,"","","") 'LD3DView.SetBillBoard (view3D pn) endif Program.Delay(10) EndFor EndWhile End>QCK206.sb< Start>QCK570.sb< GraphicsWindow.Show() 'tells computer to display graphics window GraphicsWindow.BackgroundColor = "Purple" 'set background to Purple GraphicsWindow.Width = 600 'makes window 600 pixels wide GraphicsWindow.Title = "Hello Sweden!" 'sets program title 'the above 4 lines of code will set the physical properties of your window. End>QCK570.sb< Start>QCL151.sb< ' SmallBasic Version 1.0 ' Funktion: Circle Series / Flower ' Autor: Pappa Lapub ' Herkunft: http://social.msdn.microsoft.com/Forums/en-US/ebb35085-f78f-457c-b434-8edd4484c243/challenge-of-the-month-february-2014 ' ImportURL: http://smallbasic.com/program/? ' Extension: ' Kommentar: ' ' Variablen: ' ' -------------------------------------------------------------------------------- X0 = GraphicsWindow.Width/2 - 53 Y0 = GraphicsWindow.Height/2 R = Y0/2 dPi = Math.Pi/90 ' Math.Pi/180 dN = Math.Pi/4 Turtle.Speed = 10 For N = dN To 2*Math.Pi Step dN Turtle.X = X0 + R * Math.Cos(N) Turtle.Y = Y0 + R * Math.Sin(N) For I = 0 To 360-3 Step 3 Turtle.Turn(3) Turtle.Move(3) EndFor EndFor Turtle.Hide() End>QCL151.sb< Start>QCW327.sb< 'Written by Thaelmann-Pioniere r=20 d=r*2 init() For i = 1 To 6 xofC[i]=Turtle.X-r yofC[i]=Turtle.Y-r If i>2 Or i<2 Then Turtle.Angle=direction2 Turtle.Move(r+20) GraphicsWindow.PenColor="white" Turtle.Move(r+20) xofH[i]=Turtle.X-r yofH[i]=Turtle.Y-r Turtle.PenUp() Turtle.MoveTo(xofC[i]+r,yofC[i]+r) EndIf Turtle.Angle=direction1 Turtle.PenDown() GraphicsWindow.PenColor="black" Turtle.Move(r+40+r) Turtle.Turn(60) direction1=direction1+60 direction2=direction2+60 EndFor drawatoms() Turtle.PenUp() Turtle.MoveTo(xofC[2]+r,yofC[2]+r) Turtle.Angle=0 Turtle.PenDown() Turtle.Move(r+20) GraphicsWindow.PenColor="darkblue" Turtle.Move(20+r) GraphicsWindow.BrushColor="darkblue" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) Turtle.Turn(-60) Turtle.Move(r+20) GraphicsWindow.PenColor="white" Turtle.Move(20+r) GraphicsWindow.BrushColor="white" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) Turtle.PenUp() Turtle.Turn(180) Turtle.Move(r+40+r) Turtle.Turn(-60) GraphicsWindow.PenColor="darkblue" Turtle.PenDown() Turtle.Move(r+40+r) GraphicsWindow.BrushColor="darkblue" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) x=Turtle.X y=Turtle.Y direction1=0 For i = 1 To 2 Turtle.PenDown() Turtle.Angle=direction1 GraphicsWindow.PenColor="darkblue" Turtle.Move(r+20) GraphicsWindow.PenColor="white" Turtle.Move(20+r) GraphicsWindow.BrushColor="white" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) Turtle.PenUp() Turtle.MoveTo(x,y) direction1=direction1+120 EndFor Turtle.Hide() Sub init GraphicsWindow.Title="Molecular Challenge-Phenylhydrazine(C6H5NHNH2)" GraphicsWindow.Height=600 GraphicsWindow.Width=800 GraphicsWindow.FontBold="false" GraphicsWindow.FontName="times new roman" GraphicsWindow.BrushColor="white" GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(500,20,"C") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(540,50,"6") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(560,20,"H") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(600,50,"5") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(620,20,"NHNH") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(760,50,"2") GraphicsWindow.BackgroundColor="#dabc72" Turtle.Speed=10 Turtle.PenUp() Turtle.MoveTo(320,300) Turtle.Angle=60 direction1=60 direction2=300 Turtle.PenDown() GraphicsWindow.PenWidth=15 EndSub Sub drawatoms For i = 1 To 6 If i<2 Or i>2 Then GraphicsWindow.BrushColor="black" GraphicsWindow.FillEllipse(xofC[i],yofC[i],d,d) GraphicsWindow.BrushColor="white" GraphicsWindow.FillEllipse(xofH[i],yofH[i],d,d) Else GraphicsWindow.BrushColor="black" GraphicsWindow.FillEllipse(xofC[i],yofC[i],d,d) EndIf EndFor EndSub End>QCW327.sb< Start>QCW865.sb< dw=1400 dh=900 GraphicsWindow.BackgroundColor ="Darkblue GraphicsWindow.Width = dw GraphicsWindow.Height = dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title ="Pottery, please wait to generate... T_x=0 T_y=-40 T_Angle=180 deg=44/7/360 view3D = LD3DView.AddView(dw,dh,"True") LD3DView.AddDirectionalLight(view3D,"Pink",-1,-1,-1) LD3DView.AddDirectionalLight(view3D,"white",1,1,1) LD3DView.AddAmbientLight(view3D,"#50111111") LD3DView.ResetCamera(view3D,0,0,170, 0,0,-1,"","","") r4=.5 'output ejector radius (quality factor, smaller=better and slower s12=4.5 'step factor for function sine/cosine r5=25 'pot radius sr=360/s12 'steps in one layer sy=.9*r4/sr 'z step zs=50 'pottery height pp="" yy=0 For z=-360/s12 To 360/s12*zs lx=LDMath.Cos(z*s12)*(r5)+LDMath.Cos(z*s12*10)*3 ly=LDMath.sin(z*s12)*(r5)+LDMath.sin(z*s12*10)*3 pp=pp+":"+lx+":"+(yy)+":"+ly If z>0 then yy=yy+sy endif If z>0 And z/sr<5 then r5=r5*0.9999 ElseIf z/sr>40 then r5=r5*1.0001 endif EndFor tt=LD3DView.addtube(view3d,pp,r4,20,"white","D") GraphicsWindow.Title ="Pottery 'camera orbit r170=130 LDEvents.MouseWheel =mww LD3DView.AutoControl ("true" "true", -1 5) p100=100 GraphicsWindow.KeyDown =kdd za=35 While 1=1 If pa Then else n=n+2 deg=deg-1 x=ldMath.Sin(n)*r170 z=ldmath.Cos(n)*r170 LD3DView.ResetCamera(view3D,x,za,z,-x*5,0,-z*5,"","","") Program.Delay(p100) endif EndWhile Sub mww za=za+ LDEvents.LastMouseWheelDelta*2 EndSub Sub kdd If GraphicsWindow.LastKey="Escape" Then pa="true GraphicsWindow.Title ="Pause" Else pa="false GraphicsWindow.Title ="Orbiting... EndIf EndSub End>QCW865.sb< Start>QCX116-0.sb< GraphicsWindow.Show() GraphicsWindow.Title = "1.Warriorprogramm" c = LDIOWarrior.Initialise() GraphicsWindow.DrawBoundText(420,20,200,c + " Gerät angeschlossen") a = LDIOWarrior.GetSerialNumber(1) GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + a) b = LDIOWarrior.GetName(1) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + b) GraphicsWindow.DrawBoundText(30,80,50,"Rel 1") Zeitbox = Controls.AddTextBox(80,80) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(a,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) s1 = Controls.AddButton("Start",250,70) Controls.ButtonClicked = Rel 'NEU Timer.Tick = Zeit 'NEU Sub Rel If Controls.LastClickedButton = s1 Then LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 LDIOWarrior.Write(1,0,r) 'NEU ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 Timer.Interval = ZeitMil 'NEU EndIf If Controls.LastClickedButton = aus Then LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 LDIOWarrior.Write(1,0,r) EndIf If Controls.LastClickedButton = ga Then LDIOWarrior.Detatch() EndIf If Controls.LastClickedButton = ge Then LDIOWarrior.Initialise() EndIf EndSub 'NEU Sub Zeit Timer.Pause() LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 LDIOWarrior.Write(1,0,r) EndSub 'NEU 'IM FOLGENDEM HABE ICH DEIN PROGRAMM ETWAS UMSTRUKTURIERT. DADURCH KANNST DU DAS WIEDERHOLEN VON CODE VERMEIDEN! 'WENN DU FRAGEN ETC. HAST, KANNST DU MIR GERNE EINE E-MAIL SCHICKEN: timo-soechtig@hotmail.de IO_ini() Grafikfenster() Ereignisse() Sub IO_ini c = LDIOWarrior.Initialise() a = LDIOWarrior.GetSerialNumber(1) b = LDIOWarrior.GetName(1) EndSub Sub Grafikfenster GraphicsWindow.Title = "1.Warriorprogramm" GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawBoundText(420,20,200,c + " Gerät angeschlossen") GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + a) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + b) GraphicsWindow.DrawBoundText(30,80,50,"Rel 1") Zeitbox = Controls.AddTextBox(80,80) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(a,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) s1 = Controls.AddButton("Start",250,70) EndSub Sub Ereignisse Controls.ButtonClicked = Rel Timer.Tick = Zeit EndSub Sub Rel LCB = Controls.LastClickedButton 'Dadurch wird die Geschwindigkeit erhöht. Sonst müsste jedes Mal überprüft werden welcher der zuletzt geklickte Button ist. Bei einem so kleinem Programm fällt dies zwar kaum ins Gewicht, aber es ist gut wenn man sich dies für spätere, größere Projekte aneignet If LCB = s1 Then Start() ElseIf LCB = aus Then Ausschalten() ElseIf LCB = ga Then LDIOWarrior.Detatch() ElseIf LCB = ge Then LDIOWarrior.Initialise() EndIf EndSub Sub Zeit Timer.Pause() Ausschalten() EndSub Sub Start LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 LDIOWarrior.Write(1,0,r) ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 Timer.Interval = ZeitMil EndSub Sub Ausschalten LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 LDIOWarrior.Write(1,0,r) EndSub End>QCX116-0.sb< Start>QCX116-1.sb< ' Bitte die 2 Progs vor Testen an ======== auf 2 Blätter auftrennen ' LDIO~ Commands deaktiviert und dafür Consolenausgabe ' Prog1 GraphicsWindow.Show() GraphicsWindow.Title = "1.Warriorprogramm" 'c = LDIOWarrior.Initialise() GraphicsWindow.DrawBoundText(420,20,200,"c" + " Gerät(e) angeschlossen") ' c temp als String 'a = LDIOWarrior.GetSerialNumber(1) GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + "a") ' a temp als String 'b = LDIOWarrior.GetName(1) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + "b") ' b temp als String GraphicsWindow.DrawBoundText(30,80,50,"Rel 1") Zeitbox = Controls.AddTextBox(80,80) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(aus,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) s1 = Controls.AddButton("Start",250,70) ' Ereignisse global Controls.ButtonClicked = Rel 'NEU Timer.Tick = Zeit 'NEU Sub Rel TextWindow.WriteLine(Controls.LastClickedButton) ' LastBtn = Controls.LastClickedButton ' ev. zuvor ButtonVar definieren If Controls.LastClickedButton = s1 Then 'LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 'LDIOWarrior.Write(1,0,r) 'NEU ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 Timer.Interval = ZeitMil TextWindow.WriteLine(ZeitSek + " bzw. " + ZeitMil) 'NEU ElseIf Controls.LastClickedButton = aus Then 'LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 'LDIOWarrior.Write(1,0,r) ElseIf Controls.LastClickedButton = ga Then 'LDIOWarrior.Detatch() ElseIf Controls.LastClickedButton = ge Then 'LDIOWarrior.Initialise() EndIf TextWindow.WriteLine(r) EndSub 'NEU Sub Zeit TextWindow.WriteLine("Timer abgelaufen") Timer.Pause() 'LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 'LDIOWarrior.Write(1,0,r) TextWindow.WriteLine(r) EndSub ' '========================================================================= ' Prog2 'IM FOLGENDEM HABE ICH DEIN PROGRAMM ETWAS UMSTRUKTURIERT. DADURCH KANNST DU DAS WIEDERHOLEN VON CODE VERMEIDEN! 'WENN DU FRAGEN ETC. HAST, KANNST DU MIR GERNE EINE E-MAIL SCHICKEN: timo-soechtig@hotmail.de 'IO_ini() Grafikfenster() ' Zur Fehlerbehandlung: Ev. noch Textbox-Eingabe beschränken auf: 0-9 und ev. Kommapunkt . 'Ereignisse() ' besser global im MainProg als in Sub -> sonst ev. Parallelprozesse Controls.ButtonClicked = Rel Timer.Tick = Zeit Sub IO_ini c = LDIOWarrior.Initialise() a = LDIOWarrior.GetSerialNumber(1) b = LDIOWarrior.GetName(1) EndSub Sub Grafikfenster GraphicsWindow.Title = "1.Warriorprogramm" GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawBoundText(420,20,200,c + " Gerät(e) angeschlossen") GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + a) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + b) GraphicsWindow.DrawBoundText(30,80,50,"Rel 1") Zeitbox = Controls.AddTextBox(80,80) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(a,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) s1 = Controls.AddButton("Start",250,70) EndSub Sub Ereignisse Controls.ButtonClicked = Rel Timer.Tick = Zeit EndSub Sub Rel LCB = Controls.LastClickedButton 'Dadurch wird die Geschwindigkeit erhöht. Sonst müsste jedes Mal überprüft werden welcher der zuletzt geklickte Button ist. Bei einem so kleinem Programm fällt dies zwar kaum ins Gewicht, aber es ist gut wenn man sich dies für spätere, größere Projekte aneignet TextWindow.WriteLine(LCB) If LCB = s1 Then Start() ElseIf LCB = aus Then Ausschalten() ElseIf LCB = ga Then 'LDIOWarrior.Detatch() ElseIf LCB = ge Then 'LDIOWarrior.Initialise() EndIf EndSub Sub Zeit TextWindow.WriteLine("Timer abgelaufen") Timer.Pause() Ausschalten() EndSub Sub Start 'LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 'LDIOWarrior.Write(1,0,r) TextWindow.WriteLine(r) ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 TextWindow.WriteLine(ZeitSek + " bzw. " + ZeitMil) Timer.Interval = ZeitMil EndSub Sub Ausschalten 'LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 'LDIOWarrior.Write(1,0,r) TextWindow.WriteLine(r) EndSub End>QCX116-1.sb< Start>QCX116.sb< GraphicsWindow.Show() GraphicsWindow.Title = "1.Warriorprogramm" c = LDIOWarrior.Initialise() GraphicsWindow.DrawBoundText(420,20,200,c + " Gerät angeschlossen") a = LDIOWarrior.GetSerialNumber(1) GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + a) b = LDIOWarrior.GetName(1) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + b) GraphicsWindow.DrawBoundText(30,80,50,"Rel 1") Zeitbox = Controls.AddTextBox(80,80) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(a,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) s1 = Controls.AddButton("Start",250,70) Controls.ButtonClicked = Rel Sub Rel If Controls.LastClickedButton = s1 Then LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 LDIOWarrior.Write(1,0,r) EndIf If Controls.LastClickedButton = aus Then LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 LDIOWarrior.Write(1,0,r) EndIf If Controls.LastClickedButton = ga Then LDIOWarrior.Detatch() EndIf If Controls.LastClickedButton = ge Then LDIOWarrior.Initialise() EndIf EndSub End>QCX116.sb< Start>QCX681-1.sb< GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "#88FF8C00" GraphicsWindow.BrushColor = "#88FF4500" GW = 600 Drop_Amount = 25 radius = 5 GraphicsWindow.Width = GW GraphicsWindow.Height = GW For i = 1 To Drop_Amount Drop_X[i] = Math.GetRandomNumber(GW) Drop_Y[i] = Math.GetRandomNumber(GW) Drop[i] = Shapes.AddEllipse(radius*2,radius*2) Drop_Scale[i] = 5 Drop_Radius[i] = radius*Drop_Scale[i] endfor While "True" CheckDistance() For i = 1 To Drop_Amount Drop_Radius[i] = radius*Drop_Scale[i] Shapes.Move(Drop[i],Drop_X[i]-radius,Drop_Y[i]-radius) Shapes.Zoom(Drop[i],Drop_Scale[i],Drop_Scale[i]) endfor Program.Delay(20) endwhile Sub CheckDistance For i = 1 To Drop_Amount For j = i+1 To Drop_Amount If (Drop_Radius[i]>0 and Drop_Radius[j]>0) Then Distance = Math.SquareRoot((Drop_X[i]-Drop_X[j])*(Drop_X[i]-Drop_X[j])+(Drop_Y[i]-Drop_Y[j])*(Drop_Y[i]-Drop_Y[j])) If Distance <= (Drop_Radius[i] + Drop_Radius[j]) Then Drop_X[i] = (Drop_X[i]+Drop_X[j])/2 Drop_Y[i] = (Drop_Y[i]+Drop_Y[j])/2 Drop_Scale[i] = Math.SquareRoot(Drop_Scale[i]*Drop_Scale[i]+Drop_Scale[j]*Drop_Scale[j]) Shapes.Remove(Drop[j]) Drop_Scale[j] = 0 j = Drop_Amount Else velX = (Drop_X[i] - Drop_X[j]) / Distance / Distance * 100 velY = (Drop_Y[i] - Drop_Y[j]) / Distance / Distance * 100 Drop_X[i] = Drop_X[i] - velX Drop_Y[i] = Drop_Y[i] - velY Drop_X[j] = Drop_X[j] + velX Drop_Y[j] = Drop_Y[j] + velY endif endif endfor EndFor endsub End>QCX681-1.sb< Start>QCX681.sb< GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "#88FF8C00" GraphicsWindow.BrushColor = "#88FF4500" GW = 600 Drop_Amount = 10 GraphicsWindow.Width = GW GraphicsWindow.Height = GW For i = 1 To Drop_Amount Drop_Radius[i] = 5 Drop_X[i] = Math.GetRandomNumber(GW)-50 Drop_Y[i] = Math.GetRandomNumber(GW)-50 Drop[i] = Shapes.AddEllipse(Drop_Radius[i]*2,Drop_Radius[i]*2) endfor While "True" Program.Delay(20) For i = 1 To Drop_Amount CheckDistance() Shapes.Zoom(Drop[i],Drop_Radius[i],Drop_Radius[i]) Shapes.Move(Drop[i],Drop_X[i],Drop_Y[i]) endfor endwhile Sub CheckDistance For b = 1 to Drop_Amount If b <> i Then Distance=math.SquareRoot(math.Power(Drop_X[i]-Drop_X[b],2)+math.Power(Drop_Y[i]-Drop_Y[b],2)) If Distance <= (Drop_Radius[b] + Drop_Radius[i]) Then If Drop_Radius[b] < Drop_Radius[i] Then Drop_Radius[i] = Drop_Radius[i] + Drop_Radius[b]/3 Drop_X[b] = -1000 Drop_Y[b] = -1000 Drop_Radius[b] = 0 Shapes.Remove(Drop[b]) ElseIf Drop_Radius[b] >= Drop_Radius[i] Then Drop_Radius[b] = Drop_Radius[b] + Drop_Radius[i]/3 Drop_X[i] = -1000 Drop_Y[i] = -1000 Drop_Radius[i] = 0 Shapes.Remove(Drop[i]) endif ElseIf Distance > Drop_Radius[b] and Distance < GW Then Drop_X[b] = Drop_X[b] + (Drop_X[i] - Drop_X[b]) / Distance / Distance * 100 Drop_Y[b] = Drop_Y[b] + (Drop_Y[i] - Drop_Y[b]) / Distance / Distance * 100 endif endif endfor endsub End>QCX681.sb< Start>QCX922-0.sb< ' Hello i am mahreen miangul ' HOW TO USE SHAPES IN FOREGROUND AND BACKGROUND ? ' HERE IS AN EXAMPLE GraphicsWindow.Width = 1000 GraphicsWindow.Height = 420 GraphicsWindow.BackgroundColor = "mistyrose" GraphicsWindow.FontSize = 55 GraphicsWindow.DrawText(200,280,"Hello i am mahreen miangul") MakeDonkey() ddx=-5 ddy=0 While "True" For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+ddx,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+ddx,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+ddx,shapes.GetTop(Tri[i])+ddy) EndFor If Shapes.GetLeft(ell[1])<-200 Then moveright() EndIf Program.Delay(20) endwhile Sub moveright el1y=shapes.GetTop(ell[1]) ddy= Math.GetRandomNumber(Math.Abs(300-el1y))-el1y For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+1200,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+1200,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+1200,shapes.GetTop(Tri[i])+ddy) EndFor ddy=0 EndSub Sub MakeDonkey ' 1 Ellipses GraphicsWindow.BrushColor="Black" ell[1] = Shapes.AddEllipse(45,20) Shapes.Move(ell[1], 160,15) ' <--- base point ' 13 Rectangles GraphicsWindow.BrushColor="LightGray" rec[1] = Shapes.AddRectangle(100,100) '<-- body Shapes.Move(rec[1], 160,25) GraphicsWindow.BrushColor= "Gray" rec[2] = Shapes.AddRectangle(45,45) Shapes.Move(rec[2],160,25) GraphicsWindow.BrushColor= "Lightcyan" rec[3] = Shapes.AddRectangle(45,30) Shapes.Move(rec[3],160,70) GraphicsWindow.BrushColor="LightGray" rec[4] = Shapes.AddRectangle(25,40) Shapes.Move(rec[4], 160,125) rec[5] = Shapes.AddRectangle(25,40) Shapes.Move(rec[5], 235,125) rec[6] = Shapes.AddRectangle(25,40) Shapes.Move(rec[6], 170,125) rec[7] = Shapes.AddRectangle(25,40) Shapes.Move(rec[7], 245,125) rec[8] = Shapes.AddRectangle(25,10) Shapes.Move(rec[8], 155,165) rec[9] = Shapes.AddRectangle(25,10) Shapes.Move(rec[9], 230,165) rec[10] = Shapes.AddRectangle(25,10) Shapes.Move(rec[10], 165,165) rec[11] = Shapes.AddRectangle(25,10) Shapes.Move(rec[11], 240,165) rec[12] = Shapes.AddRectangle(8,30) Shapes.Move(rec[12], 252,35) rec[13] = Shapes.AddRectangle(8,6) Shapes.Move(rec[13], 252,65) ' 2 Trangles GraphicsWindow.BrushColor="Pink" Tri[1] = Shapes.Addtriangle(0,0,15,0,8,12) Shapes.Move(Tri[1], 145,25) Tri[2] = Shapes.Addtriangle(0,0,15,0,8,12) Shapes.Move(Tri[2], 205,25) ' 4 Ellipses GraphicsWindow.BrushColor="Red" ell[2] = Shapes.AddEllipse(5,8) Shapes.Move(ell[2], 175,35) ell[3] = Shapes.AddEllipse(5,8) Shapes.Move(ell[3], 185,35) GraphicsWindow.BrushColor="Black" ell[4] = Shapes.AddEllipse(5,8) Shapes.Move(ell[4], 175,80) ell[5] = Shapes.AddEllipse(5,8) Shapes.Move(ell[5], 185,80) ' 1 Trangles Tri[3] = Shapes.Addtriangle(0,0,35,10,30,10) Shapes.Move(Tri[3], 130,10) EndSub End>QCX922-0.sb< Start>QCX922.sb< ' Hello i am mahreen miangul ' HOW TO USE SHAPES IN FOREGROUND AND BACKGROUND ? ' HERE IS AN EXAMPLE GraphicsWindow.Width = 1000 GraphicsWindow.Height = 420 GraphicsWindow.BackgroundColor = "mistyrose" GraphicsWindow.FontSize = 55 GraphicsWindow.DrawText(200,280,"Hello i am mahreen miangul") ' 1 Ellipses GraphicsWindow.BrushColor="RED" miangulBOX = Shapes.AddEllipse(100,100) Shapes.Move(miangulBOX, 160,20) GraphicsWindow.BrushColor="ORANGE" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX, 180,40) GraphicsWindow.BrushColor="YELLOW" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX, 200,60) GraphicsWindow.BrushColor= "BLUE" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX,220,80) GraphicsWindow.BrushColor= "GREEN" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX,240,100) GraphicsWindow.BrushColor= "INDIGO" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX,260,120) GraphicsWindow.BrushColor="VIOLET" miangulBOX = Shapes.Addellipse(100,100) Shapes.Move(miangulBOX, 280,140) ' 2 Rectangles GraphicsWindow.BrushColor="RED" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX, 350,20) GraphicsWindow.BrushColor= "ORANGE" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX,380,40) GraphicsWindow.BrushColor= "YELLOW" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX,410,60) GraphicsWindow.BrushColor= "BLUE" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX,440,80) GraphicsWindow.BrushColor="GREEN" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX, 470,100) GraphicsWindow.BrushColor="INDIGO" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX, 500,120) GraphicsWindow.BrushColor="VIOLET" haroonBOX = Shapes.AddRectangle(100,100) Shapes.Move(haroonBOX, 530,140) ' 3 Trangles GraphicsWindow.BrushColor="RED" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 550,20) GraphicsWindow.BrushColor="ORANGE" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 580,40) GraphicsWindow.BrushColor="YELLOW" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 610,60) GraphicsWindow.BrushColor="BLUE" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 640,80) GraphicsWindow.BrushColor="GREEN" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 670,100) GraphicsWindow.BrushColor="INDIGO" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 700,120) GraphicsWindow.BrushColor="VIOLET" rashidBOX = Shapes.Addtriangle(100,100,200, 100,150,20) Shapes.Move(rashidBOX, 730,140) End>QCX922.sb< Start>QDF403.sb< ' Easy maze game All shape version By NaochanON ' Use Right Left Up Down keys GraphicsWindow.KeyDown=onkeydown GUI() Sub onkeydown If NNstars[2] Then ' 2= ■ check if text.GetSubText(a,target,1)=stars[3] Then ' 3 ☆ check NN=NN+1 ' count gotten stars EndIf c=Text.GetSubText(a,1,playerpos-1)+stars[1]+Text.GetSubTextToEnd(a,playerpos+1) a=Text.GetSubText(c,1,target-1)+stars[4]+Text.GetSubTextToEnd(c,target+1) playerpos=target Shapes.SetText(base,a) Shapes.Move(base,Shapes.GetLeft(base)-SZ*dxx[KeyNo],Shapes.GetTop(base)-SZ*dyy[KeyNo]) ' move to new position endif msg="There are "+starnumber+" stars. You've gotten "+NN +" stars. row= " GraphicsWindow.Title=msg+Math.Ceiling(target/(MM+2))+"/"+MM+" column ="+(target-(MM+2)*Math.Floor(target/(MM+2)))+"/"+MM Else GraphicsWindow.BrushColor="red" GraphicsWindow.DrawText(100,5," Finished !!!!!!!!!!!!!! " ) Sound.PlayBellRingAndWait() endif EndSub Sub GUI SZ=25 MM=75 GraphicsWindow.FontSize=SZ GraphicsWindow.Width=sz*40 GraphicsWindow.Height=SZ*25 stars="1=・;2=■;3=☆;4="+text.GetCharacter(2*16*16*16+6*16*16+12*16+4) For i=1 To MM*MM NMB= 1+Math.Floor(1/Math.GetRandomNumber(6))+Math.Floor(1/Math.GetRandomNumber(75)) a=a+stars[NMB] If Math.Remainder(i,MM)=0 and iQDF403.sb< Start>QDG054.sb< GraphicsWindow.BackgroundColor="midnightblue gw=600' MDR869 GraphicsWindow.Width=gw GraphicsWindow.Height=gw*1.5 GraphicsWindow.PenWidth=0 s30=20 GraphicsWindow.Title="Space Invaders Tribute 2018 For y=0 To (gw/s30)*1.5 For x=0 To gw/s30 GraphicsWindow.BrushColor=LDColours.HSLtoRGB (10*(45-y)/1.5 1 .55) ss=Shapes.AddRectangle (s30 s30) If Math.GetRandomNumber (25)<2 then LDEffect.DropShadow (ss "ShadowDepth=3") LDShapes.AnimateRotation (ss math.GetRandomNumber (1500)+500 0) endif Shapes.Move (ss x*s30 y*s30) Shapes.SetOpacity (ss 5) aa[x+1][y+1]=LDFastShapes.ShapeIndex (ss) mm[x+1][y+1]=0 EndFor EndFor GraphicsWindow.MouseMove=mmm ee= Shapes.AddRectangle (50 70) LDShapes.BrushColour (ee "white") GraphicsWindow.MouseDown=ddd mmm() Sub ddd ll=Shapes.AddEllipse (15 15) Shapes.Move (ll Shapes.GetLeft (ee)+20 850) Shapes.Animate (ll Shapes.GetLeft (ee)+20, -30 500) EndSub Sub mmm Shapes.Move (ee GraphicsWindow.MouseX 850) EndSub args=0 For j=0 to 40 step 6 For i=-30 to 50 Step 2 For m=-32 to 0 step 8 For k=-20 to 30 step 8 If nnlive[m][k]=1 then 'death allien(( else ldcall.Function5("rct" k+3+i 2+j+m, 3 3 1) ldcall.Function5("rct" k+2+i 3+j+m 5 3 1) ldcall.Function5("rct" k+3+i 4+j+m 3 2 0) ldcall.Function5("rct" k+4+i 4+j+m 0 2 1) If Math.GetRandomNumber (500)<3 then nnlive[m][k]=1 endif endif endfor endfor shww() For m=-32 to 0 step 8 For k=-20 to 30 step 8 ldcall.Function5("rct" k+2+i 2+j+m 6 4 0) endfor EndFor Program.Delay (155) endfor endfor GraphicsWindow.BrushColor="Lime gg=Shapes.AddText ("GAME OVER") LDShapes.Font (gg "Lucda console" 66 "true" "false") LDShapes.Centre (gg 300 400) LDShapes.AnimateOpacity (gg 500 0) LDShapes.AnimateZoom(gg 750 5 2 2) Program.Delay (8888) Program.End () Sub rct For x=args[1] To args[3]+args[1] For y= args[2] To args[4]+args[2] If x>0 and x<30 then If args[5]=1 Then mm[x][y]=1 Else mm[x][y]=0 EndIf endif EndFor EndFor EndSub Sub shww For x=1 To 30 For y= 1 To 45 If mm[x][y]=1 Then ldfastShapes.SetOpacity (aa[x][y] 95) Else ldfastShapes.SetOpacity (aa[x][y] 5) EndIf EndFor EndFor LDFastShapes.Update () EndSub End>QDG054.sb< Start>QDH330.sb< TextWindow.Title = "Text Challenge 2 - November 2012" TextWindow.Top = 0 TextWindow.Left = 0 TextWindow.ForegroundColor = "DarkGreen" TextWindow.WriteLine("(C) Joman. Version 1.0") TextWindow.Write("Welcome! What is your name? ") name = TextWindow.Read() TextWindow.WriteLine("How are you today, " + name + "?") TextWindow.Write("Press 1 for Great!, 2 for Okay, or 3 for Not Very Good: ") mood = TextWindow.ReadNumber() If mood = "1" Then TextWindow.Write("That's good! I am glad to hear that! So, tell me, " + name + ", what is your hobby? ") hobby = TextWindow.Read() Goto Next ElseIf mood = "2" Then TextWindow.Write("You're feeling only 'okay'? What's your hobby? That might cheer you up! ") hobby = TextWindow.Read() Goto Next ElseIf mood = "3" then TextWindow.Write("I am sorry to hear that, " + name + "! Maybe your hobby would make you feel better! What is your hobby? ") hobby = TextWindow.Read() Goto Next Else TextWindow.Write("Please input a valid number: ") EndIf Next: TextWindow.Write("Where do you live? ") live = TextWindow.Read() TextWindow.WriteLine("So you " + hobby + " in/at " + live + "? Sounds interesting!") Program.Delay(2000) TextWindow.Write("What time is it? (HH:MM AM/PM) [Write with colon ':'] ") Time = TextWindow.Read() TextWindow.WriteLine("Here is your overview:") TextWindow.WriteLine("Your name is " + name + ", who lives in/at " + live + ", where you " + hobby + " at " + Time + ".") Program.Delay(5000) TextWindow.Write("It has been great talking to you, " + name + "! Bye.") Program.Delay(1500) Program.End() End>QDH330.sb< Start>QDJ934.sb< TextWindow.Write("Please enter a binary number: ") BinaryInput = TextWindow.ReadNumber() For Bits = 1 To Text.GetLength(BinaryInput) TextWindow.Write("bits: " + Bits) TextWindow.Write(" 2 to the power of " + (Bits - 1)) TextWindow.Write(" = " + Math.Power(2,Bits-1)) TextWindow.Write(" times " + Text.GetSubText(BinaryInput,Text.GetLength(BinaryInput)-Bits + 1,1)) TextWindow.Write(" = " + (Math.Power(2,Bits-1) * Text.GetSubText(BinaryInput,Text.GetLength(BinaryInput)-Bits + 1,1))) runningTotal = runningTotal + (Math.Power(2,Bits-1) * Text.GetSubText(BinaryInput,Text.GetLength(BinaryInput)-Bits + 1,1)) TextWindow.WriteLine(" adding these = " + runningTotal) DecimalOutput = DecimalOutput + Text.GetSubText(BinaryInput,Text.GetLength(BinaryInput)-Bits + 1,1) * Math.Power(2,Bits-1)' EndFor TextWindow.WriteLine("Decimal form: "+DecimalOutput) End>QDJ934.sb< Start>QDK083.sb< Debug="True" 'to set to false counter=0 args = "" ' The following line could be harmful and has been automatically commented. ' DebugFile="debugFile.txt" ' The following line could be harmful and has been automatically commented. ' File.DeleteFile(DebugFile) ' The following line could be harmful and has been automatically commented. ' File.AppendContents(DebugFile,"DebugFile : "+Clock.date+" = "+Clock.time) ' The following line could be harmful and has been automatically commented. ' File.AppendContents(DebugFile,"=================================") for x=1 to 500 LDCall.Function("DebugFunc","x= "+x+" !") endfor 'END PROGRAM 'Function subroutine Sub DebugFunc if debug then TextWindow.WriteLine(args[1]) counter=counter+1 if math.remainder(x,100)=0 then TextWindow.Pause() endif endif ' The following line could be harmful and has been automatically commented. ' File.AppendContents(DebugFile,args[1]) EndSub End>QDK083.sb< Start>QDM794.sb< 'IM FOLGENDEM HABE ICH DEIN PROGRAMM ETWAS UMSTRUKTURIERT. DADURCH KANNST DU DAS WIEDERHOLEN VON CODE VERMEIDEN! 'WENN DU FRAGEN ETC. HAST, KANNST DU MIR GERNE EINE E-MAIL SCHICKEN: timo-soechtig@hotmail.de IO_ini() Grafikfenster() Ereigniss() Sub IO_ini c = LDIOWarrior.Initialise() a = LDIOWarrior.GetSerialNumber(1) b = LDIOWarrior.GetName(1) EndSub Sub Grafikfenster GraphicsWindow.Title = "1.Warriorprogramm" GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawBoundText(420,20,200,c + " Gerät angeschlossen") GraphicsWindow.DrawBoundText(10,20,200,"Seriennummer: " + a) GraphicsWindow.DrawBoundText(220,20,200,"Gerätename: " + b) GraphicsWindow.DrawBoundText(80,60,150,"Zeit in sek eingeben") Zeitbox = Controls.AddTextBox(80,80) CB1 = LDControls.AddCheckBox("Rel 1") LDControls.CheckBoxState(CB1,"False") Controls.Move(CB1,80,120) CB2 = LDControls.AddCheckBox("Rel 2") LDControls.CheckBoxState(CB2,"False") Controls.Move(CB2,170,120) Start = Controls.AddButton("Start",130,180) aus = Controls.AddButton ("Relais aus",350,70) Controls.SetSize(a,150,30) ge = Controls.AddButton("Gerät einschalten",350,120) Controls.SetSize(ge,150,30) ga = Controls.AddButton("Geräte trennen",350,170) Controls.SetSize(ga,150,30) EndSub Sub Ereigniss Controls.ButtonClicked = Button Timer.Tick = Zeit EndSub Sub Button LCB = Controls.LastClickedButton 'Dadurch wird die Geschwindigkeit erhöht. Sonst müsste jedes Mal überprüft werden welcher der zuletzt geklickte Button ist. Bei einem so kleinem Programm fällt dies zwar kaum ins Gewicht, aber es ist gut wenn man sich dies für spätere, größere Projekte aneignet If LCB = aus Then Ausschalten() ElseIf LCB = ga Then LDIOWarrior.Detatch() ElseIf LCB = ge Then LDIOWarrior.Initialise() ElseIf LCB = Start Then Box() EndIf EndSub LDControls.CheckBoxChanged = Box Sub Box If CB1 Then Start1() ElseIf CB2 Then Start2() EndIf EndSub Sub Zeit Timer.Pause() Ausschalten() EndSub Sub Ausschalten LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 255 r[3] = 255 LDIOWarrior.Write(1,0,r) EndSub Sub Start1 LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 254 r[3] = 255 LDIOWarrior.Write(1,0,r) ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 Timer.Interval = ZeitMil EndSub Sub Start2 LDIOWarrior.GetReportSize(0) r[1] = 0 r[2] = 253 r[3] = 255 LDIOWarrior.Write(1,0,r) ZeitSek = Controls.GetTextBoxText(Zeitbox) ZeitMil = ZeitSek*1000 Timer.Interval = ZeitMil EndSub End>QDM794.sb< Start>QDR256.sb< ' Stop Watch 0.1 GraphicsWindow.Title = "Stop Watch 0.1 - [Space] for start/stop, [Enter] for lap/reset" gw = 640 gh = 480 GraphicsWindow.Width = gw GraphicsWindow.Height = gh start = "False" lapped = "False" delta = 0 nLap = 0 fs = 20 x1 = gw / 2 - fs * 6 / Math.SquareRoot(2) - fs y1 = gh / 2 - fs * 6 / Math.SquareRoot(2) - fs x2 = gw / 2 + fs * 6 / Math.SquareRoot(2) - fs y2 = gh / 2 - fs * 6 / Math.SquareRoot(2) - fs x3 = gw / 2 - fs * 6 y3 = gh / 2 - fs * 6 x4 = gw / 2 - fs * 5 y4 = gh / 2 - fs * 5 x = gw / 2 - fs * 4.6 y = gh / 2 - fs * 1.2 GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillEllipse(x1, y1, fs * 2, fs * 2) GraphicsWindow.FillEllipse(x2, y2, fs * 2, fs * 2) GraphicsWindow.BrushColor = "#333333" GraphicsWindow.FillEllipse(x3, y3, fs * 12, fs * 12) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillEllipse(x4, y4, fs * 10, fs * 10) GraphicsWindow.BrushColor = "DarkSeaGreen" GraphicsWindow.FillRectangle(x, y, fs * 9.2, fs * 2.4) ms = 0 MilliSecToTime() GraphicsWindow.FontName = "Courier New" GraphicsWindow.FontSize = fs GraphicsWindow.BrushColor = "Black" oNum = Shapes.AddText("[0]") Shapes.Move(oNum, x, y) oLap = Shapes.AddText(t) Shapes.Move(oLap, x + fs * 2.4, y) oTime = Shapes.AddText(t) Shapes.Move(oTime, x + fs * 2.4, y + fs * 1.2) GraphicsWindow.KeyDown = OnKeyDown Timer.Interval = 10 Timer.Tick = OnTick Timer.Pause() Sub OnKeyDown key = GraphicsWindow.LastKey If key = "Space" Then ' start/stop If start Then ' stop ltime = Clock.ElapsedMilliseconds delta = ltime - stime start = "False" Timer.Pause() Else ' start stime = Clock.ElapsedMilliseconds - delta lltime = stime start = "True" Timer.Resume() EndIf ElseIf key = "Return" Then ' lap/reset If start Then ' lap ltime = Clock.ElapsedMilliseconds nLap = nLap + 1 ms = ltime - lltime MilliSecToTime() Shapes.SetText(oNum, "[" + nLap + "]") Shapes.SetText(oLap, t) lltime = ltime lapped = "True" Else ' reset If lapped Then nLap = nLap + 1 ms = ltime - lltime MilliSecToTime() Shapes.SetText(oNum, "[" + nLap + "]") Shapes.SetText(oLap, t) lapped = "False" Else delta = 0 ms = 0 MilliSecToTime() Shapes.SetText(oTime, t) nLap = 0 Shapes.SetText(oNum, "[0]") Shapes.SetText(oLap, t) EndIf EndIf EndIf 'ShowLap() 'ShowTime() EndSub Sub OnTick ctime = Clock.ElapsedMilliseconds If start Then ms = ctime - stime MilliSecToTime() Shapes.SetText(oTime, t) EndIf EndSub Sub MilliSecToTime ' param ms - millisecond ' returns t - time frac = Math.Remainder(Math.Floor(ms / 10), 100) sec = Math.Remainder(Math.Floor(ms / 1000), 60) If Text.GetLength(sec) = 1 Then sec = Text.Append(0, sec + frac / 100) Else sec = sec + frac / 100 EndIf If Text.GetLength(sec) <= 2 Then sec = Text.Append(sec, ".00") ElseIf Text.GetLength(sec) <= 4 Then sec = Text.Append(sec, 0) EndIf min = Math.Remainder(Math.Floor(ms / 60000), 60) If Text.GetLength(min) = 1 Then min = Text.Append(0, min) EndIf hour = Math.Remainder(Math.Floor(ms / 3600000), 60) If Text.GetLength(hour) = 1 Then hour = Text.Append(0, hour) EndIf t = hour + ":" + min + ":" + sec EndSub End>QDR256.sb< Start>QDS394.sb< ' Program by Yvan Leduc , April 24th 2016 ' Moonlight Sonata de Beethoven adapté pour le piano sur Small Basic ' 1er preview program no : PHW283 GraphicsWindow.Top =0 GraphicsWindow.left =0 GraphicsWindow.Height=768 GraphicsWindow.Width=1366 GraphicsWindow.fontname="AR Decode" GraphicsWindow.BackgroundColor="Black" image1=imagelist.LoadImage( "https://upload.wikimedia.org/wikipedia/commons/thumb/a/aa/Beethoven_bust_statue_by_Hagen.jpg/403px-Beethoven_bust_statue_by_Hagen.jpg") GraphicsWindow.DrawImage(image1,75,0) GraphicsWindow.FontSize=80 GraphicsWindow.BrushColor="#E7D3AD" GraphicsWindow.DrawboundText(500,100,500,"Moonlight Sonata") GraphicsWindow.FontSize=45 GraphicsWindow.BrushColor="#E7A3AA" GraphicsWindow.DrawboundText(500,300,800,"Piano Sonata No14, Op. 27- No2, 1° mvt") GraphicsWindow.FontSize=45 GraphicsWindow.BrushColor="#E7B3AB" GraphicsWindow.DrawboundText(550,500,800,"Ludwig van Beethoven") GraphicsWindow.FontSize=20 GraphicsWindow.brushcolor="gray" GraphicsWindow.DrawText(900,650,"Program and Music Arangement by Yvan Leduc @ 2016") LDImage.EffectCyan(image1) shp= Shapes.AddImage(image1) Shapes.Move(shp,75,0) LDShapes.AnimateOpacity(shp, 10000, 0) MEASURE() For M= 1 To 15 For T=1 TO 12 sound.PlayMusic (a["M"+M][t]+n["M"+M][t]) a["M"+M][t]="" n["M"+M][t]="" endfor ENDFOR SUB MEASURE a["M1"][1]="O2L64 C#" +"O3L64 C#" n["M1"][1]="O4L4 G#" n["M1"][2]="O5L4 C#" n["M1"][3]="O5L4 E" n["M1"][4]="O4L4 G#" n["M1"][5]="O5L4 C#" n["M1"][6]="O5L4 E" n["M1"][7]="O4L4 G#" n["M1"][8]="O5L4 C#" n["M1"][9]="O5L4 E" n["M1"][10]="O4L4 G#" n["M1"][11]="O5L4 C#" n["M1"][12]="O5L4 E" a["M2"][1]="O2L64 B" +"O3L64 B" n["M2"][1]="O4L4 G#" n["M2"][2]="O5L4 C#" n["M2"][3]="O5L4 E" n["M2"][4]="O4L4 G#" n["M2"][5]="O5L4 C#" n["M2"][6]="O5L4 E" n["M2"][7]="O4L4 G#" n["M2"][8]="O5L4 C#" n["M2"][9]="O5L4 E" n["M2"][10]="O4L4 G#" n["M2"][11]="O5L4 C#" n["M2"][12]="O5L4 E" a["M3"][1]="O2L64 A" +"O3L64 A" n["M3"][1]="O4L4 A" n["M3"][2]="O5L4 C#" n["M3"][3]="O5L4 E" n["M3"][4]="O4L4 A" n["M3"][5]="O5L4 C#" n["M3"][6]="O5L4 E" a["M3"][7]="O2L64 F#" +"O3L64 F#" n["M3"][7]="O4L4 A" n["M3"][8]="O5L4 D" n["M3"][9]="O5L4 F#" n["M3"][10]="O4L4 A" n["M3"][11]="O5L4 D#" n["M3"][12]="O5L4 F#" a["M4"][1]="O2L64 G#" +"O3L64 G#" n["M4"][1]="O4L4 G#" n["M4"][2]="O5L4 B#" ' dans le mesure 5 les Si sont # ( rare ) jusqu a ce q ont rencontre un becarre n["M4"][3]="O5L4 F#" n["M4"][4]="O4L4 G#" n["M4"][5]="O5L4 C#" n["M4"][6]="O5L4 E" a["M4"][7]="O2L64 G#" +"O3L64 G#" n["M4"][7]="O4L4 G#" n["M4"][8]="O5L4 C#" n["M4"][9]="O5L4 E" n["M4"][10]="O4L4 G#" n["M4"][11]="O5L4 B#" ' SI diese ( ou Dob) n["M4"][12]="O5L4 D#" a["M5"][1]="O3L64 C#" +"O4L64 G#" n["M5"][1]="O4L4 E" n["M5"][2]="O4L4 G#" n["M5"][3]="O4L4 C#" n["M5"][4]="O4L4 G#" n["M5"][5]="O5L4 C#" n["M5"][6]="O5L4 E" n["M5"][7]="O4L4 G#" n["M5"][8]="O5L4 C#" n["M5"][9]="O5L4 E" a["M5"][10]="O4L64 G#" +"O6L64 G#" n["M5"][10]="O6L4 G#" ' mp n["M5"][11]="O5L4 C#" a["M5"][12]="O5L64 E" +"O6L64 G#" n["M5"][12]="O5L4 E" a["M6"][1]="O3L64 F#" +"O4L64 B#" n["M6"][1]="O6L4 G#" n["M6"][2]="O5L4 D#" n["M6"][3]="O5L4 F#" n["M6"][4]="O4L4 G#" n["M6"][5]="O5L4 D#" n["M6"][6]="O5L4 F#" n["M6"][7]="O4L4 G#" n["M6"][8]="O5L4 D#" n["M6"][9]="O5L4 F#" a["M6"][10]="O4L64 G#" +"O6L64 G#" n["M6"][10]="O6L4 G#" n["M6"][11]="O4L4 D#" a["M6"][12]="O5L64 F#" +"O6L64 G#" n["M6"][12]="O5L4 F#" a["M7"][1]="O3L64 C#" +"O4L64 G#" n["M7"][1]="O6L4 G#" n["M7"][2]="O5L4 C#" n["M7"][3]="O5L4 E" n["M7"][4]="O4L4 G#" n["M7"][5]="O5L4 C#" n["M7"][6]="O5L4 E" a["M7"][7]="O3L64 F#" +"O4L64 A" n["M7"][7]="O6L4 A" n["M7"][8]="O4L4 C#" n["M7"][9]="O5L4 F#" n["M7"][10]="O4L4 A" n["M7"][11]="O5L4 C#" n["M7"][12]="O5L4 F#" a["M8"][1]="O3L64 B" +"O4L64 G#" n["M8"][1]="O6L4 G#" n["M8"][2]="O4L4 B" ' SI normal n["M8"][3]="O5L4 E" n["M8"][4]="O4L4 G#" n["M8"][5]="O4L4 B" ' SI normal mais o4 pas o5 ici ets la limite du do n["M8"][6]="O5L4 E" a["M8"][7]="O3L64 B" +"O4L64 G#" n["M8"][7]="O6L4 F#" n["M8"][8]="O4L4 B" n["M8"][9]="O4L4 D#" a["M8"][10]="O4L64 A"+"O6L64 B" n["M8"][10]="O6L4 B" n["M8"][11]="O4L4 B" n["M8"][12]="O5L4 D#" a["M9"][1]="O3L64 E" +"O4L64 G#" n["M9"][1]="O6L4 E" n["M9"][2]="O4L4 B" n["M9"][3]="O5L4 E" n["M9"][4]="O4L4 G#" n["M9"][5]="O4L4 B" n["M9"][6]="O5L4 E" n["M9"][7]="O4L4 G#" n["M9"][8]="O4L4 B" n["M9"][9]="O5L4 E" n["M9"][10]="O4L4 G#" n["M9"][11]="O4L4 B" n["M9"][12]="O5L4 E" a["M10"][1]="O3L64 E" +"O4L64 E" n["M10"][1]="O4L4 G" n["M10"][2]="O4L4 B" n["M10"][3]="O5L4 E" n["M10"][4]="O4L4 G" n["M10"][5]="O4L4 B" n["M10"][6]="O5L4 E n["M10"][7]="O4L4 G" n["M10"][8]="O4L4 B" n["M10"][9]="O5L4 E" a["M10"][10]="O3L64 G" +"O6L64 G" n["M10"][10]="O6L4 G" n["M10"][11]="O4L4 B" a["M10"][12]="O5L64 E" +"O6L64 G" n["M10"][12]="O5L4 E" a["M11"][1]="O3L64 D" +"O6L64 G" n["M11"][1]="O6L4 G" n["M11"][2]="O4L4 B" n["M11"][3]="O5L4 F" n["M11"][4]="O4L4 G" n["M11"][5]="O4L4 B" n["M11"][6]="O5L4 F" n["M11"][7]="O4L4 G" n["M11"][8]="O4L4 B" n["M11"][9]="O5L4 F" a["M11"][10]="O3L64 G" +"O6L64 G" n["M11"][10]="O6L4 G" n["M11"][11]="O4L4 F" a["M11"][12]="O5L64 E" +"O6L64 G" n["M11"][12]="O6L4 G" a["M12"][1]="O3L64 G" +"O6L64 G" n["M12"][1]="O6L4 G" n["M12"][2]="O4L4 C" n["M12"][3]="O5L4 E" a["M12"][4]="O2L64 B" +"O3L64 B" n["M12"][4]="O5L4 G" n["M12"][5]="O4L4 C" n["M12"][6]="O5L4 E" a["M12"][7]="O2L64 A#" +"O3L64 A#" n["M12"][7]="O5L4 G" n["M12"][8]="O5L4 C#" n["M12"][9]="O5L4 E" a["M12"][10]="O4L64 F#" +"O6L64 F#" n["M12"][10]="O6L4 F#" n["M12"][11]="O4L4 A#" n["M12"][12]="O5L4 C" a["M13"][1]="O2L64 B" +"O6L64 F#" n["M13"][1]="O6L4 F#" n["M13"][2]="O4L4 B" n["M13"][3]="O5L4 D" ' becarre n["M13"][4]="O4L4 F#" n["M13"][5]="O4L4 B" n["M13"][6]="O5L4 D" ' becarre a["M13"][7]="O3L64 E" +"O6L64 G" n["M13"][7]="O6L4 G" ' becarre n["M13"][8]="O4L4 B" n["M13"][9]="O5L4 C#" a["M13"][10]="O3L64 G" +"O6L64 E" n["M13"][10]="O6L4 E" n["M13"][11]="O4L4 B" n["M13"][12]="O5L4 C#" a["M14"][1]="O3L64 F#" +"O6L64 F#" n["M14"][1]="O6L4 F#" n["M14"][2]="O4L4 B" n["M14"][3]="O5L4 D" ' becarre n["M14"][4]="O4L4 F#" n["M14"][5]="O4L4 B" n["M14"][6]="O5L4 D" ' becarre a["M14"][7]="O2L64 F#" +"O6L64 F#" n["M14"][7]="O6L4 F#" ' becarre n["M14"][8]="O4L4 A#" n["M14"][9]="O5L4 C#" n["M14"][10]="O4L4 F#" ' becarre n["M14"][11]="O4L4 A#" n["M14"][12]="O5L4 C#" a["M15"][1]="O3L64 B" +"O5L64 B" n["M15"][1]="O5L4 B" n["M15"][2]="O4L4 D" n["M15"][3]="O4L4 F#" n["M15"][4]="O4L4 B" n["M15"][5]="O5L4 D" n["M15"][6]="O5L4 F#" n["M15"][7]="O4L4 D" n["M15"][8]="O5L4 D#" n["M15"][9]="O5L4 F#" a["M15"][10]="O4L64 B" +"O6L64 B" n["M15"][10]="O6L4 B" n["M15"][11]="O5L4 D#" n["M15"][12]="O5L4 F#" ENDSUB End>QDS394.sb< Start>QDS710.sb< ' TESTING CODE buttonClicked = "False" Controls.ButtonClicked = OnButtonClicked SelectPenColor() GraphicsWindow.Title = GraphicsWindow.PenColor Sub OnButtonClicked buttonClicked = "True" EndSub ' PLUG-IN Sub SelectPenColor ' return selectedPenColor - returned if new pen color is selected ' draw dialog gw = GraphicsWindow.Width gh = GraphicsWindow.Height dw = 260 dh = 160 pw = GraphicsWindow.PenWidth bc = GraphicsWindow.BrushColor fs = GraphicsWindow.FontSize GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "Gray" dialog = Shapes.AddRectangle(dw, dh) Shapes.SetOpacity(dialog, 50) dLeft = (gw - dw) / 2 dTop = (gh - dh) / 2 Shapes.Move(dialog, dLeft, dTop) ' draw buttons GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 12 dOK = Controls.AddButton("OK", dLeft + 10, dTop + dh - 40) dCancel = Controls.AddButton("Cancel", dLeft + 50, dTop + dh - 40) ' draw current pen color pcCandidate = GraphicsWindow.PenColor GraphicsWindow.BrushColor = pcCandidate penColor = Shapes.AddRectangle(100, 100) Shapes.Move(penColor, dLeft + 10, dTop + 10) ' draw palette palette = "0=Black;1=Red;2=Green;4=Blue;" pIndex = Array.GetAllIndices(palette) pNum = Array.GetItemCount(palette) pLeft = dLeft + 120 pTop = dTop + 10 For i = 1 To pNum GraphicsWindow.BrushColor = palette[pIndex[i]] pSquare[i] = Controls.AddButton("■", pLeft + (i - 1) * 30, pTop) EndFor continue = "True" While continue If buttonClicked Then button = Controls.LastClickedButton If button = dOK Then selectedPenColor = pcCandidate GraphicsWindow.PenColor = selectedPenColor continue = "False" ElseIf button = dCancel Then continue = "False" Else For i = 1 To pNum If button = pSquare[i] Then pcCandidate = palette[pIndex[i]] GraphicsWindow.BrushColor = pcCandidate Shapes.Remove(penColor) penColor = Shapes.AddRectangle(100, 100) Shapes.Move(penColor, dLeft + 10, dTop + 10) EndIf EndFor EndIf buttonClicked = "False" Else Program.Delay(200) EndIf EndWhile ' remove controls and dialog Shapes.Remove(penColor) For i = 1 To pNum Controls.Remove(pSquare[i]) EndFor Controls.Remove(dOK) Controls.Remove(dCancel) Shapes.Remove(dialog) ' restore properties GraphicsWindow.FontSize = fs GraphicsWindow.PenWidth = pw GraphicsWindow.BrushColor = bc EndSub End>QDS710.sb< Start>QDW452.sb< Initialise() '============================================ 'SUBROUTINES '============================================ Sub Initialise 'Buttons buttonLabel[1] = "Save" buttonLabel[2] = "Load" buttonLabel[3] = "Font" buttonLabel[4] = "Colour" buttonLabel[5] = "Set Default" buttonLabel[6] = "Set Selection" buttonLabel[7] = "Clear" numButton = Array.GetItemCount(buttonLabel) buttonWidth = 100 For i = 1 To numButton button[i] = Controls.AddButton(buttonLabel[i],(buttonWidth+10)*(i-1)+10,10) Controls.SetSize(button[i],buttonWidth,30) EndFor 'Window size GraphicsWindow.Width = numButton*(buttonWidth+10)+10 + 160 'RichTextBox richTextBox = LDControls.AddRichTextBox(GraphicsWindow.Width-20,GraphicsWindow.Height-60) Shapes.Move(richTextBox,10,50) sampleRichTextBox = LDControls.AddRichTextBox(150,30) Shapes.Move(sampleRichTextBox,(buttonWidth+10)*numButton+10,10) setSample() 'Initial parameters fileName = "" font[1] = LDControls.RichTextBoxFontFamily font[2] = LDControls.RichTextBoxFontSize font[3] = LDControls.RichTextBoxFontBold font[4] = LDControls.RichTextBoxFontItalic colour = "" folder = Program.Directory 'Events LDEvents.Resized = OnResized Controls.ButtonClicked = OnButtonClicked EndSub Sub setSample LDControls.RichTextBoxSetText(sampleRichTextBox,LDControls.RichTextBoxFontFamily,"False") LDControls.RichTextBoxDefault(sampleRichTextBox) EndSub '============================================ 'EVENT SUBROUTINES '============================================ Sub OnResized LDShapes.SetSize(richTextBox,GraphicsWindow.Width-20,GraphicsWindow.Height-60) EndSub Sub OnButtonClicked If (Controls.LastClickedButton = button[1]) Then fileName = LDDialogs.SaveFile("rtf",folder) LDControls.RichTextBoxSave(richTextBox,fileName) ElseIf (Controls.LastClickedButton = button[2]) Then fileName = LDDialogs.OpenFile("rtf",folder) LDControls.RichTextBoxLoad(richTextBox,fileName,"False") ElseIf (Controls.LastClickedButton = button[3]) Then font = LDDialogs.Font(font) TextWindow.WriteLine("Font Size "+font[2]) LDControls.RichTextBoxFontFamily = font[1] LDControls.RichTextBoxFontSize = font[2] LDControls.RichTextBoxFontBold = font[3] LDControls.RichTextBoxFontItalic = font[4] ElseIf (Controls.LastClickedButton = button[4]) Then colour = LDDialogs.Colour() LDControls.RichTextBoxFontForeground = colour ElseIf (Controls.LastClickedButton = button[5]) Then LDControls.RichTextBoxDefault(richTextBox) ElseIf (Controls.LastClickedButton = button[6]) Then TextWindow.WriteLine("Using Font Size "+LDControls.RichTextBoxFontSize) LDControls.RichTextBoxSelection(richTextBox) ElseIf (Controls.LastClickedButton = button[7]) Then LDControls.RichTextBoxClear(richTextBox) EndIf setSample() EndSub End>QDW452.sb< Start>QDX206.sb< ' Scroll Text 0.2b ' Copyright (c) 2014 Nonki Takahashi. The MIT License. ' ' History: ' 0.2b 2014-08-28 Changed to trapezoid scroll. ' 0.1a 2014-08-28 Created rectangular scroll. ' GraphicsWindow.Title = "Scroll Text 0.2b" Init() Stars() For iText = 1 To 100 If Array.ContainsIndex(txt, iText) Then GraphicsWindow.BrushColor = "#020202" GraphicsWindow.DrawText(xSource, ySource, txt[iText]) AddLines() GraphicsWindow.BrushColor = "#000000" GraphicsWindow.FillRectangle(0, ySource, gw, h) EndIf ScrollLines() EndFor Sub Stars colors = "1=Blue;2=White;" GraphicsWindow.PenWidth = 0 For i = 1 To 1000 GraphicsWindow.BrushColor = colors[Math.GetRandomNumber(2)] x = Math.GetRandomNumber(gw + 4) - 3 y = Math.GetRandomNumber(gh + 4) - 3 size = Math.GetRandomNumber(2) star = Shapes.AddEllipse(size, size) Shapes.Move(star, x, y) EndFor GraphicsWindow.PenColor = "#FFFFFF" GraphicsWindow.PenWidth = 1 EndSub Sub DrawGrid GraphicsWindow.PenColor = "#666666" For x = 0 To gw Step 10 GraphicsWindow.DrawLine(x, 0, x, gh - 1) EndFor For y = 0 To gh Step 10 GraphicsWindow.DrawLine(0, y, gw - 1, y) EndFor GraphicsWindow.PenColor = "#999999" For x = 0 To gw Step 100 GraphicsWindow.DrawLine(x, 0, x, gh - 1) EndFor For y = 0 To gh Step 100 GraphicsWindow.DrawLine(0, y, gw - 1, y) EndFor GraphicsWindow.PenColor = "Red" GraphicsWindow.DrawLine(xDest, 0, xDest, gh - 1) GraphicsWindow.DrawLine(0, yDest, gw - 1, yDest) EndSub Sub Init Not = "Ture=False;False=True;" gw = 598 gh = 428 xc = gw / 2 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "#000000" fs = 30 GraphicsWindow.FontSize = fs GraphicsWindow.FontName = "Arial" txt[1] = "A long time ago in a galaxy far, far away," txt[2] = "an incredible adventure took place......" xSource = 10 ySource = gh - fs * 1.5 xDest = 10 ' left x of the lower base yDest = gh - fs * 2 ' y of the lower base a = 45 ' angle for a trapezoid from vertical line to side line _a = Math.GetRadians(a) w = 500 h = Math.Floor(fs * 1.5) s = 1 - 2 / w * Math.Tan(_a) ' upper / lower base scale for a trapezoid with a pixel height EndSub Sub AddLines y = ySource sigmaH = 0 For i = 1 To h scale = Math.Power(s, h - i) iLine = iLine + 1 iRun = 1 x = 0 While x < gw ' find start point of a run found = "False" While x < gw And Not[found] GetPixel() If color <> "#000000" Then line[iLine]["x" + iRun] = x - xSource found = "True" EndIf x = x + 1 EndWhile ' find end point of a run found = "False" While x < gw And Not[found] GetPixel() If color = "#000000" Then line[iLine]["len" + iRun] = x - xSource - line[iLine]["x" + iRun] line[iLine]["obj" + iRun] = Shapes.AddLine(0, 0, line[iLine]["len" + iRun], 0) xRun = xc - (xc - line[iLine]["x" + iRun] - xDest) * scale Shapes.Move(line[iLine]["obj" + iRun], xRun, sigmaH + yDest) Shapes.Zoom(line[iLine]["obj" + iRun], scale, scale) iRun = iRun + 1 found = "True" EndIf x = x + 1 EndWhile EndWhile y = y + 1 sigmaH = sigmaH + scale If yTop = "" Then yTop = yDest EndIf EndFor EndSub Sub Profile If emsLast = "" Then emsLast = Clock.ElapsedMilliseconds Else ems = Clock.ElapsedMilliseconds ms = ems - emsLast TextWindow.WriteLine((ms / 1000) + "[sec]") emsLast = ems EndIf EndSub Sub GetPixel ' param x, y - to get pixel color ' return color color = GraphicsWindow.GetPixel(x, y) len = Text.GetLength(color) If 7 < len Then ' for Silverlight color = "#" + Text.GetSubTextToEnd(color, len - 5) EndIf EndSub Sub DumpLines nLine = Array.GetItemCount(line) For i = 1 To nLine TextWindow.WriteLine(line[i]) EndFor EndSub Sub ScrollLines nLine = Array.GetItemCount(line) For iy = 1 To h n = yDest - yTop - 1 scale = Math.Power(s, n) opacity = Math.Floor((y - 100) / (yDest - 101) * 90) + 10 iLast = 0 sigmaH = 0 For j = 1 To n scale = Math.Power(s, j - 1) sigmaH = sigmaH + scale EndFor For i = 1 To nLine index = Array.GetAllindices(line) _iLine = index[i] nRun = Array.GetItemCount(line[_iLine]) / 3 scale = Math.Power(s, h + yDest - yTop - _iLine - 1) sigmaH = sigmaH - scale y = yDest - sigmaH For iRun = 1 To nRun Shapes.SetOpacity(line[_iLine]["obj" + iRun], opacity) x = xc - (xc - line[_iLine]["x" + iRun] - xDest) * scale Shapes.Move(line[_iLine]["obj" + iRun], x, y) Shapes.Zoom(line[_iLine]["obj" + iRun], scale, scale) EndFor EndFor yTop = yTop - 1 EndFor EndSub End>QDX206.sb< Start>QDX521.sb< ' 8-Queens 0.2 ' Copyright (c) 2012 Nonki Takahashi ' ' History : ' 0.2 2013/01/03 Rewrote for 8-Queens probrem. () ' 0.1 2012/08/04 Code for chessmen written in hexadecimal. ' 0.0 2012/08/04 25-line version created. (CLP327) ' GraphicsWindow.Title = "8-Queens 0.2" GraphicsWindow.BackgroundColor = "#004C00" GraphicsWindow.BrushColor = "Black" oNum = Controls.AddTextBox(440, 30) num = 12345678 Controls.SetTextBoxText(oNum, num) InitBoard() CheckValid() DrawBoard() Controls.TextTyped = OnTextTyped Sub OnTextTyped num = Controls.GetTextBoxText(oNum) len = Text.GetLength(num) correct = "False" If len = 8 Then correct = "True" For i = 1 To 8 If Text.IsSubText(num, Text.GetSubText("12345678", i, 1)) = "False" Then correct = "False" EndIf EndFor EndIf If correct Then board = "" For c = 1 To 8 board[Text.GetSubText(num, c, 1)][Text.GetSubText("abcdefgh", c, 1)] = "BQ" EndFor CheckValid() DrawBoard() EndIf EndSub Sub CheckValid valid = "True" For c1 = 1 To 8 For c2 = c1 + 1 To 8 r1 = Text.GetSubText(num, c1, 1) r2 = Text.GetSubText(num, c2, 1) dc = Math.Abs(c2 - c1) dr = Math.Abs(r2 - r1) If dc = dr Then valid = "False" board[r1][Text.GetSubText("abcdefgh", c1, 1)] = "RQ" board[r2][Text.GetSubText("abcdefgh", c2, 1)] = "RQ" EndIf EndFor EndFor EndSub Sub DrawBoard For r = 8 To 1 Step - 1 y = pos["y0"] + (8 - r) * size For c = 1 To 8 x = pos["x0"] + (c - 1) * size GraphicsWindow.BrushColor = color[Math.Remainder((c + r), 2)] GraphicsWindow.FillRectangle(x, y, size, size) p = board[r][Text.GetSubText("abcdefgh", c, 1)] If p <> "" Then GraphicsWindow.BrushColor = color[Text.GetSubText(p, 1, 1)] sHex = pieces[Text.GetSubText(p, 2, 1)] Math_Hex2Dec() GraphicsWindow.DrawText(x, y - size * 0.12, Text.GetCharacter(iDec)) EndIF EndFor EndFor EndSub Sub InitChessmen size = 48 ' font height and square size GraphicsWindow.FontSize = size pieces = "P=265F;N=265E;B=265D;R=265C;Q=265B;K=265A;" EndSub Sub InitBoard pos = "x0=30;y0=30;" ' left, top For c = 1 To 8 board[c][Text.GetSubText("abcdefgh", c, 1)] = "BQ" EndFor color = "W=White;B=Black;R=Red;0=SaddleBrown;1=BurlyWood;" InitChessmen() EndSub Sub Math_Hex2Dec ' Math | Convert sHex to iDec iDec = 0 iLen = Text.GetLength(sHex) For iPtr = 1 To iLen iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1 EndFor EndSub Sub DumpBoard For r = 8 To 1 Step -1 For c = 1 To 8 If board[r][Text.GetSubText("abcdefgh", c, 1)] <> "" Then TextWindow.Write(board[r][Text.GetSubText("abcdefgh", c, 1)] + " ") Else TextWindow.Write(" ") EndIf EndFor TextWindow.WriteLine("") EndFor EndSub End>QDX521.sb< Start>QDX927.sb< r200=150 GraphicsWindow.BackgroundColor ="darkblue GraphicsWindow.BrushColor="gold GraphicsWindow.Width=900 GraphicsWindow.Height=900 GraphicsWindow.Left=5 GraphicsWindow.Top=5 view3D = LD3DView.AddView(900 900,"true") 'Will not clip to size if window rescaled LD3DView.AddDirectionalLight (view3D,"white",-1 ,-1 ,-1) LD3DView.AddDirectionalLight(view3D,"white",1,1,1) LD3DView.AddAmbientLight(view3D,"#55888888") r35=60 ya=30 aa=45 px= LDMath.Cos(aa) py= LDMath.sin (aa) LD3DView.ResetCamera(view3D, px*r35,ya,py*r35, -px, -.5, -py, "","","") LD3DView.AutoControl ("true" "true", -1 3) i=1 GraphicsWindow.KeyDown=kkk GraphicsWindow.Title="3D dog jumps dd=":" args=0 GraphicsWindow.BrushColor=LDColours.HSLtoRGB (30 .9 .7) a2=3 r20=40 not="false=true;true=false rtt="true w="-1 4 0:0 0 0 LD3DView.AddTube (view3D w 1 12 GraphicsWindow.BrushColor "D") hd=LD3DView.AddSphere (view3D 1.3 20 GraphicsWindow.BrushColor "D") LD3DView.TranslateGeometry (view3D hd, -1 4 0) While "true For r=r20 To 180-r20 Step a2 mcam() endfor For r=180-r20 To r20 Step -a2 mcam() EndFor endwhile Sub kkk rtt=not[rtt] EndSub Sub mtub cc=ldtext.Replace (args[1] "d5" 3) cc=ldtext.Replace (cc "h0" hh0) return=LD3DView.AddTube (view3D cc 1 12 GraphicsWindow.BrushColor "D") EndSub sub mcam r5=5 hh=hh+3 hh0=ldmath.FixDecimal (math.Abs(ldmath.Sin(hh))*-2 3) 'GraphicsWindow.Title=hh0 py=-ldmath.FixDecimal (ldmath.Sin(r)*r5 3) px=ldmath.cos(r)*r5 px1=ldmath.cos(r)*r5 w="0 0 0:0 0 d5:"+px+dd+py+dd+":d5 ww="0 0 0:0 0 -d5:"+px1+dd+py+dd+":-d5 tt=LDCall.Function ("mtub" w ) tt1=LDCall.Function ("mtub" ww ) r5=5 py=-ldmath.Sin(r)*r5 px=ldmath.cos(180-r)*r5+10 px1=ldmath.cos(180-r)*r5+10 w="10 h0 0:10 h0 d5:"+px+dd+(py+hh0)+dd+":d5 ww="10 h0 0:10 h0 -d5:"+px1+dd+(py+hh0)+dd+":-d5 qtt=LDCall.Function ("mtub" w ) qtt1=LDCall.Function ("mtub" ww ) w="0 0 0:10 h0 0 b1=LDCall.Function ("mtub" w ) px= LDMath.Cos(aa) py= LDMath.sin (aa) LD3DView.ResetCamera(view3D, px*r35,ya,py*r35, -px, -.5, -py, "","","") If rtt then aa=aa+.55 endif ' LD3DView.TranslateGeometry (view3D tt LDMath.Cos(aa)*r20 LDMath.sin(aa)*r20 r*5) Program.Delay (33) LD3DView.ModifyObject (view3D tt "X") LD3DView.ModifyObject (view3D tt1 "X") LD3DView.ModifyObject (view3D qtt "X") LD3DView.ModifyObject (view3D qtt1 "X") LD3DView.ModifyObject (view3D b1 "X") EndSub End>QDX927.sb< Start>QFB498.sb< ' Challenge of the month December 2012 by NaochanON ' Draw a Christmas tree GUI() While "true" showstarH2() Program.Delay(1000) showstarH1() Program.Delay(1000) blinking() Program.Delay(1000) showstarV2() Program.Delay(1000) showstarV1() Program.Delay(1000) endwhile Sub snowing NN=NN+1 Shapes.Move(snow1[NN],Math.GetRandomNumber(1000),-(100+Math.GetRandomNumber(300))) Shapes.Move(snow2[NN],Math.GetRandomNumber(1000),-(100+Math.GetRandomNumber(300))) ZM=(5+Math.GetRandomNumber(20))/10 Shapes.Zoom(snow1[NN],ZM,ZM) Shapes.Zoom(snow2[NN],ZM,ZM) Shapes.Animate(snow1[NN],Shapes.GetLeft(snow1[NN]),700-Math.GetRandomNumber(250),2000+Math.GetRandomNumber(2000)) Shapes.Animate(snow2[NN],Shapes.GetLeft(snow2[NN]),700-Math.GetRandomNumber(150),2000+Math.GetRandomNumber(2000)) If NN>SN Then NN=0 EndIf EndSub Sub showstarH1 For i=pitch To 1 Step -1 For j=1 To 20 For k=1 to M Shapes.SetOpacity(star1[K][j][i],100) Shapes.SetOpacity(star2[K][j][i],0) EndFor EndFor snowing() EndFor EndSub Sub showstarH2 For i=1 To pitch For j=1 To 20 For k=1 to M Shapes.SetOpacity(star1[K][j][i],0) Shapes.SetOpacity(star2[K][j][i],100) EndFor EndFor snowing() EndFor EndSub Sub showstarV1 For j=20 To 1 Step -1 For i=1 To pitch For k=1 to M Shapes.SetOpacity(star1[K][j][i],100) Shapes.SetOpacity(star2[K][j][i],0) EndFor EndFor snowing() EndFor EndSub Sub showstarV2 For k=1 to M For j=1 To 20 For i=1 To pitch Shapes.SetOpacity(star1[K][j][i],0) Shapes.SetOpacity(star2[K][j][i],100) EndFor EndFor snowing() EndFor EndSub Sub blinking For i=1 To pitch For j=1 To 20 For k=1 to M PCNT=2-Math.GetRandomNumber(2) ' 1 or 0 Shapes.SetOpacity(star1[K][j][i],100*PCNT) Shapes.SetOpacity(star2[K][j][i],100*(1-PCNT)) EndFor EndFor snowing() EndFor EndSub Sub GUI GraphicsWindow.Hide() GraphicsWindow.Width=1000 GraphicsWindow.Height=700 GraphicsWindow.Top=10 GraphicsWindow.Left=50 GraphicsWindow.BackgroundColor="Black" GraphicsWindow.BrushColor="Lightcyan" GraphicsWindow.PenColor="Lightcyan" '-------------------- Snow back ----------------------------------- SN=1000 For L=1 To SN snow1[L]= Shapes.AddText("*") Shapes.Move(snow1[L],100,-100) endfor '------------------------------------------------------------------------- M=4 For k=1 To M '-------------------- Position ----------------------------------- X0=30 +(150+Math.GetRandomNumber(100))*(k-1) ' left position Top=20+Math.GetRandomNumber(120) ' tree top y-position Xw=200 +Math.GetRandomNumber(50) ' tree width Height=300+Math.GetRandomNumber(100) ' tree height XC=Xw/2+X0 ' tree top x-position 8center) Y0=Top+Height ' tree bottom Pitch=12 ' light number '-------------------- Tree --------------------------------------- GraphicsWindow.BrushColor="saddlebrown" GraphicsWindow.PenColor="saddlebrown" tree1[K]=Shapes.AddTriangle(0,Height+90,60,Height+90,30,0) Shapes.Move(tree1[K],xc-30+3,top) GraphicsWindow.BrushColor="Darkgreen" GraphicsWindow.PenColor="Darkgreen" tree2[K]=Shapes.AddTriangle(0,Height,Xw-10,Height,Xw/2,0) Shapes.Move(tree2[K],x0+3,top) '-------------------- star Light --------------------------------------- For j=1 To pitch For i=1 To pitch y=Y0-(height/Pitch)*i dx0=Xw/Pitch*(j-1) x=x0+dx0+((Xw-2*dx0)/2/Pitch)*i GraphicsWindow.BrushColor="Yellow" GraphicsWindow.PenColor="yellow" star1[K][j][i]=Shapes.AddText("★") GraphicsWindow.BrushColor="cyan" GraphicsWindow.PenColor="cyan" star2[K][j][i]=Shapes.AddText("*") Shapes.Move(star1[K][j][i],x,y) Shapes.Move(star2[K][j][i],x,y) Shapes.SetOpacity(star2[K][j][i],0) EndFor EndFor '------------------------------------------------------------------------- endfor '-------------------- Snow Front ----------------------------------- GraphicsWindow.BrushColor="Lightcyan" GraphicsWindow.PenColor="Lightcyan" For L=1 To SN snow2[L]= Shapes.AddText("*") Shapes.Move(snow2[L],100,-100) endfor '------------------------------------------------------------------------- GraphicsWindow.Show() EndSub End>QFB498.sb< Start>QFD918-0.sb< 'TextWindow.Show() GraphicsWindow.Show() GraphicsWindow.Width=1000 GraphicsWindow.Height=700 GraphicsWindow.Top=0 GraphicsWindow.MouseDown=onmousedown 'TextWindow.WriteLine("Hello There") 'GraphicsWindow.DrawText(128,128,"Hello There") Sub onmousedown If Mouse.MouseX>512 then TextWindow.Hide() GraphicsWindow.DrawText(128,128,"Hello There") ElseIf Mouse.MouseY<512 then GraphicsWindow.Hide() TextWindow.WriteLine("Hello There") TextWindow.Write("Press any Key") TextWindow.Read() GraphicsWindow.Show() EndIf EndSub End>QFD918-0.sb< Start>QFD918.sb< TextWindow.Show() GraphicsWindow.Show() TextWindow.WriteLine("Hello There") GraphicsWindow.DrawText(128,128,"Hello There") If Mouse.MouseX>512 then TextWindow.Hide() ElseIf Mouse.MouseY>512 then GraphicsWindow.Hide() EndIf End>QFD918.sb< Start>QFF913-0.sb< 'Written by Thaelmann-Pioniere init() drawchessboard() drawchesses() newroundstart() While cancontinue = "true" And GraphicsWindow.LastKey <> "Escape" If Array.GetItemCount(DDRarmy) = 0 Then GraphicsWindow.FontSize = 96 GraphicsWindow.PenColor = "White" GraphicsWindow.DrawText(50,50,"West won!") Sound.PlayMusic("O5 C3 O4 B8 B8 A8 G4 A3 G8 G8 F8 E4 D3 E8 F8 G8 A8 F8 D8 C4 E8 D8 C2") Sound.PlayMusic("O5 C3 O4 B8 B8 A8 G4 A3 G8 G8 F8 E4 D3 E8 F8 G8 A8 F8 D8 C4 E8 D8 C1.5")'"Deutschlandlied" cancontinue = "false" ElseIf Array.GetItemCount(BRDarmy) = 0 Then GraphicsWindow.ShowMessage("East won!","") Sound.PlayMusic("O5 B4 B4 A4 G4 O6 C4 C4 O5 B4 A4 O6 D4 O5 B4 G4 O6 D4 D3 E8 C4 O5 G8 A8 B2 A2 O6 D2 O5 G4 A4 B2 A2 G1.5")'"Auferstanden aus Ruinen" cancontinue = "false" EndIf If round = "BRD" And armyx < 2 And move[armyx][armyy] > 0 Then GraphicsWindow.KeyDown = OnKeyDown EndIf EndWhile If GraphicsWindow.LastKey = "Escape" Then Program.End() EndIf '----------Subroutines------------------------------------------------------------------------------------------------------------------ Sub init GraphicsWindow.Title = "Iron Curtain - Konrad v.s. Walter" GraphicsWindow.Width = 190 GraphicsWindow.Height = 190 GraphicsWindow.CanResize = "false" clicknumber = 0 cancontinue = "true" round = "BRD" EndSub Sub drawchessboard For x = 1 To 2 For y = 1 To 2 GraphicsWindow.BrushColor = "MediumBlue" area[x][y] = Shapes.AddRectangle(100,100) Shapes.Move(area[x][y],x*100-100,y*100-100) EndFor EndFor LDShapes.BrushColour(area[2][1],"Red") GraphicsWindow.BrushColor = "OrangeRed" Bonn = LDShapes.AddStar(5,10,30) Shapes.Move(Bonn,20,120) Berlin = LDShapes.AddStar(5,10,30) Shapes.Move(Berlin,120,20) EndSub Sub drawchesses GraphicsWindow.BrushColor = "Gold" DDRarmy[2][1] = Shapes.AddEllipse(80,80) Shapes.Move(DDRarmy[2][1],110,10) move["DDRarmy"][1] = 1'DDR Army GraphicsWindow.BrushColor = "DodgerBlue" BRDarmy[1][2] = Shapes.AddEllipse(80,80) Shapes.Move(BRDarmy[1][2],10,110) move["BRDarmy"][1] = 1'BRD Army EndSub Sub newroundstart If round = "BRD" Then armyx = 1 armyy = 2 LDShapes.BrushColour(area[armyx][armyy],"DarkBlue") For i = 1 To Array.GetItemCount(DDRarmy) move["BRDarmy"][i] = 1 EndFor areacolor1 = "MediumBlue" areacolor2 = "DarkBlue" ElseIf round = "DDR" Then armyx = 2 armyy = 1 LDShapes.BrushColour(area[2][1],"DarkRed") For i = 1 To Array.GetItemCount(DDRarmy) move["DDRarmy"][i] = 1 EndFor areacolor1 = "Red" areacolor2 = "DarkRed" EndIf EndSub Sub OnKeyDown lk = GraphicsWindow.LastKey If lk = "A" Then Shapes.Animate(BRDarmy[armyx][armyy],armyx*100-100,armyy*100,100) ElseIf lk = "D" Then Shapes.Animate(BRDarmy[armyx][armyy],armyx*100+100,armyy*100,100) ElseIf lk = "W" Then Shapes.Animate(BRDarmy[armyx][armyy],armyx*100,armyy*100-100,100) ElseIf lk = "X" Then Shapes.Animate(BRDarmy[armyx][armyy],armyx*100,armyy*100+100,100) ElseIf lk = "Left" Then LDShapes.BrushColour(area[armyx][armyy],areacolor1) LDShapes.BrushColour(area[armyx-1][armyy],areacolor2) armyx=armyx-1 ElseIf lk = "Right" Then LDShapes.BrushColour(area[armyx][armyy],areacolor1) LDShapes.BrushColour(area[armyx+1][armyy],areacolor2) armyx=armyx+1 ElseIf lk = "Up" Then LDShapes.BrushColour(area[armyx][armyy],areacolor1) LDShapes.BrushColour(area[armyx][armyy-1],areacolor2) armyy=armyy-1 ElseIf lk = "Down" Then LDShapes.BrushColour(area[armyx][armyy],areacolor1) LDShapes.BrushColour(area[armyx][armyy+1],areacolor2) armyy=armyy+1 EndIf EndSub End>QFF913-0.sb< Start>QFF913.sb< 'Written by Thaelmann-Pioniere init() drawchessboard() drawchesses() While cancontinue="true" If Array.GetItemCount(DDRarmy)=0 Then GraphicsWindow.ShowMessage("West won!","") Sound.PlayMusic("O4 T10 C3 O3 B8 B8 A8 G4 A3 G8 G8 F8 E4 D3 E8 F8 G8 A8 F8 D8 C4 E8 D8 C2")'"Deutschlandlied" ElseIf Array.GetItemCount(BRDarmy)=0 Then GraphicsWindow.ShowMessage("East won!","") Sound.PlayMusic("O4 T10 C3 O3 B8 B8 A8 G4 A3 G8 G8 F8 E4 D3 E8 F8 G8 A8 F8 D8 C4 E8 D8 C2")'"Auferstanden aus Ruinen" EndIf If Mouse.IsLeftButtonDown="true" Then If Math.Floor(Mouse.MouseX/100)-1>0 And Math.Floor(Mouse.MouseY/100)<5 Then If round="BRD" Then LDShapes.BrushColour(BRDarmy[Math.Floor(Mouse.MouseX/100)+1][Math.Floor(Mouse.MouseY/100)],"PaleTurquoise") ElseIf round="DDR" Then LDShapes.BrushColour(DDRarmy[Math.Floor(Mouse.MouseX/100)+1][Math.Floor(Mouse.MouseY/100)],"Aqua") EndIf EndIf EndIf EndWhile Sub init GraphicsWindow.Title="Iron Curtain - Konrad v.s. Walter" GraphicsWindow.Width=390 GraphicsWindow.Height=390 GraphicsWindow.CanResize="false" cancontinue="true" round="BRD" EndSub Sub drawchessboard For i = 1 To 4 For j = 1 To 4 If i>2 And j<4 Then GraphicsWindow.BrushColor="Red" Else GraphicsWindow.BrushColor="MediumBlue" EndIf area[i][j]=Shapes.AddRectangle(100,100) Shapes.Move(area[i][j],i*100-100,j*100-100) EndFor EndFor GraphicsWindow.BrushColor="OrangeRed" Bonn=LDShapes.AddStar(5,10,30) Shapes.Move(Bonn,20,220) Berlin=LDShapes.AddStar(5,10,30) Shapes.Move(Berlin,320,120) EndSub Sub drawchesses GraphicsWindow.BrushColor="Gold" For i = 2 To 3 For j = 1 To 3 DDRarmy[i][j]=Shapes.AddEllipse(80,80) Shapes.Move(DDRarmy[i][j],i*100-100+110,j*100-100+10) EndFor EndFor'DDR Army GraphicsWindow.BrushColor="DodgerBlue" For i = 0 To 1 For j = 1 To 3 BRDarmy[i][j]=Shapes.AddEllipse(80,80) Shapes.Move(BRDarmy[i][j],i*100-100+110,j*100-100+10) EndFor EndFor For i = 0 To 3 BRDarmy[i][4]=Shapes.AddEllipse(80,80) Shapes.Move(BRDarmy[i][4],i*100-100+110,4*100-100+10) EndFor Shapes.Remove(BRDarmy[0][1]) Shapes.Remove(BRDarmy[1][4]) Shapes.Remove(BRDarmy[0][4])'BRD Army EndSub End>QFF913.sb< Start>QFL408-0.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" ' Asteroid (rock) settings rockSpeed = 1 rockColor = "white" rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerColor = "white" playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" bigRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_BigRock.png") medRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_MediumRock.png") smlRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_SmallRock.png") background = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Sky.jpg") ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + "0" GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor GraphicsWindow.DrawImage(background, 0, 0) LevelCheck() GraphicsWindow.PenColor = playerColor player = Shapes.AddImage("http://smallbasic.com/drop/Asteroids_Ship.png") Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 EndSub ' Main gane routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = ChangeDirection ' Main loop play = 1 pause = 0 While(play = 1) Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(GraphicsWindow.LastKey = rightKey) Then playerAngle = Math.Remainder(playerAngle + 10, 360) ElseIf(GraphicsWindow.LastKey = leftKey) Then playerAngle = Math.Remainder(playerAngle - 10, 360) ElseIf(GraphicsWindow.LastKey = forwardKey) Then playerSpeed = playerSpeed + 1 ElseIf(GraphicsWindow.LastKey = backKey) Then playerSpeed = playerSpeed - 1 ElseIf(GraphicsWindow.LastKey = fireKey) Then Fire() ElseIf(GraphicsWindow.LastKey = pauseKey) Then pause = Math.Remainder(pause + 1, 2) EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then EndGame() EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextRemove = j RemoveAmmo() EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock GraphicsWindow.PenColor = rockColor If size = 60 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(bigRock)) ElseIf size = 40 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(medRock)) Else Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(smlRock)) EndIf Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 Else ' We've destroyed it - give some extra points and score = score + 5 EndIf ' Show updated score GraphicsWindow.Title = gameTitle + (score * pointsMultiply) ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For i = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, i, Array.GetValue(rock, i+1)) Array.SetValue(rockAngle, i, Array.GetValue(rockAngle, i+1)) Array.SetValue(rockSize, i, Array.GetValue(rockSize, i+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextRemove = 1 RemoveAmmo() EndWhile ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextRemove)) For i = nextRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, i, Array.GetValue(ammo, i+1)) Array.SetValue(ammoAngle, i, Array.GetValue(ammoAngle, i+1)) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + (score * pointsMultiply) + " points. Thanks for Playing.", "Game Over!") EndSub End>QFL408-0.sb< Start>QFL408-3.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" 'Keypress flags KeyLeft = 0 KeyRight = 0 KeyForward = 0 KeyBack = 0 KeyFire = 0 KeyPause = 0 ' Asteroid (rock) settings rockSpeed = 1 rockColor = "white" rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerColor = "white" playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" bigRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_BigRock.png") medRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_MediumRock.png") smlRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_SmallRock.png") background = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Sky.jpg") ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + "0" GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor GraphicsWindow.DrawImage(background, 0, 0) LevelCheck() GraphicsWindow.PenColor = playerColor player = Shapes.AddImage("http://smallbasic.com/drop/Asteroids_Ship.png") Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 EndSub ' Main gane routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp ' Main loop play = 1 pause = 0 While(play = 1) ChangeDirection() Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(KeyRight = 1) Then playerAngle = Math.Remainder(playerAngle + 10, 360) ElseIf(KeyLeft = 1) Then playerAngle = Math.Remainder(playerAngle - 10, 360) ElseIf(KeyForward = 1) Then playerSpeed = playerSpeed + 1 ElseIf(KeyBack = 1) Then playerSpeed = playerSpeed - 1 ElseIf(KeyFire = 1) Then Fire() KeyFire = 2 ' Dont register another shot until the Key is released ElseIf(KeyPause = 1) Then pause = Math.Remainder(pause + 1, 2) KeyPause = 0 EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then EndGame() EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextRemove = j RemoveAmmo() EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock GraphicsWindow.PenColor = rockColor If size = 60 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(bigRock)) ElseIf size = 40 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(medRock)) Else Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(smlRock)) EndIf Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 Else ' We've destroyed it - give some extra points and score = score + 5 EndIf ' Show updated score GraphicsWindow.Title = gameTitle + (score * pointsMultiply) ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For i = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, i, Array.GetValue(rock, i+1)) Array.SetValue(rockAngle, i, Array.GetValue(rockAngle, i+1)) Array.SetValue(rockSize, i, Array.GetValue(rockSize, i+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextRemove = 1 RemoveAmmo() EndWhile ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextRemove)) For i = nextRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, i, Array.GetValue(ammo, i+1)) Array.SetValue(ammoAngle, i, Array.GetValue(ammoAngle, i+1)) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + (score * pointsMultiply) + " points. Thanks for Playing.", "Game Over!") EndSub 'KeyDown Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 1 ElseIF (Key = rightKey) Then KeyRight = 1 ElseIF (Key = forwardKey) Then KeyForward = 1 ElseIF (Key = backKey) Then KeyBack = 1 ElseIF (KeyFire = 0 And Key = fireKey) Then ' Only fire if the key has been released since the last shot KeyFire = 1 ElseIF (Key = pauseKey) Then KeyPause = 1 EndIf EndSub 'Key Up Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 0 ElseIF (Key = rightKey) Then KeyRight = 0 ElseIF (Key = forwardKey) Then KeyForward = 0 ElseIF (Key = backKey) Then KeyBack = 0 ElseIF (Key = fireKey) Then KeyFire = 0 EndIf EndSub End>QFL408-3.sb< Start>QFL408-4.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" ' Asteroid (rock) settings rockSpeed = 1 initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up maxSpeed = 10 drag = 3 ' percentage of speed lost on each screen update ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" ' Game graphics bigRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_BigRock.png") medRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_MediumRock.png") smlRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_SmallRock.png") background = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Sky.jpg") shipImage = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Ship.png") ' Asteroid settings graphics version. ' -- Don't change without appropriate mod to code. rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) 'Keypress flags KeyLeft = 0 KeyRight = 0 KeyForward = 0 KeyBack = 0 KeyFire = 0 KeyPause = 0 ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + "0" GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor GraphicsWindow.DrawResizedImage(background, 0, 0, gameWidth, gameHeight) LevelCheck() player = Shapes.AddImage(shipImage) Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 EndSub ' Main gane routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp ' Main loop play = 1 pause = 0 While(play = 1) ChangeDirection() Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(KeyRight = 1) Then playerAngle = Math.Remainder(playerAngle + 10, 360) EndIf If(KeyLeft = 1) Then playerAngle = Math.Remainder(playerAngle - 10, 360) EndIf If(KeyForward = 1) Then If (playerSpeed < maxSpeed) Then playerSpeed = playerSpeed + 1 EndIf EndIf If(KeyBack = 1) Then If (playerSpeed > (0 - maxSpeed)) Then playerSpeed = playerSpeed - 1 EndIf EndIf If(KeyFire = 1) Then Fire() KeyFire = 2 ' Dont register another shot until the Key is released EndIf If(KeyPause = 1) Then pause = Math.Remainder(pause + 1, 2) KeyPause = 0 EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) playerSpeed = playerSpeed - (playerSpeed / 100 * drag) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then EndGame() EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextAmmoRemove = j RemoveAmmo() j = ammoMax EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock If size = 60 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(bigRock)) ElseIf size = 40 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(medRock)) Else Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(smlRock)) EndIf Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 * pointsMultiply Else ' We've destroyed it - give some extra points and score = score + 5 * pointsMultiply EndIf ' Show updated score GraphicsWindow.Title = gameTitle + score ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For i = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, i, Array.GetValue(rock, i+1)) Array.SetValue(rockAngle, i, Array.GetValue(rockAngle, i+1)) Array.SetValue(rockSize, i, Array.GetValue(rockSize, i+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextAmmoRemove = 1 RemoveAmmo() EndWhile If (score >= pointsMultiply / 2) Then score = score - (pointsMultiply / 2) ' Show updated score GraphicsWindow.Title = gameTitle + score EndIf ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextAmmoRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextAmmoRemove)) For i = nextAmmoRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, i, Array.GetValue(ammo, i+1)) Array.SetValue(ammoAngle, i, Array.GetValue(ammoAngle, i+1)) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + score + " points. Thanks for Playing.", "Game Over!") EndSub 'KeyDown Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 1 ElseIF (Key = rightKey) Then KeyRight = 1 ElseIF (Key = forwardKey) Then KeyForward = 1 ElseIF (Key = backKey) Then KeyBack = 1 ElseIF (KeyFire = 0 And Key = fireKey) Then ' Only fire if the key has been released since the last shot KeyFire = 1 ElseIF (Key = pauseKey) Then KeyPause = 1 EndIf EndSub 'Key Up Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 0 ElseIF (Key = rightKey) Then KeyRight = 0 ElseIF (Key = forwardKey) Then KeyForward = 0 ElseIF (Key = backKey) Then KeyBack = 0 ElseIF (Key = fireKey) Then KeyFire = 0 EndIf EndSub End>QFL408-4.sb< Start>QFL408-7.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" hyperspaceKey = "H" ' Asteroid (rock) settings rockSpeed = 1 initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up maxSpeed = 10 drag = 3 ' percentage of speed lost on each screen update ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" ' Game graphics bigRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_BigRock.png") medRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_MediumRock.png") smlRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_SmallRock.png") background = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Sky.jpg") shipImage = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Ship.png") ' Asteroid settings graphics version. ' -- Don't change without appropriate mod to code. rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) 'Keypress flags KeyLeft = 0 KeyRight = 0 KeyForward = 0 KeyBack = 0 KeyFire = 0 KeyPause = 0 KeyHyperspace = 0 ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + "0" GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor GraphicsWindow.DrawResizedImage(background, 0, 0, gameWidth, gameHeight) LevelCheck() player = Shapes.AddImage(shipImage) Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 score = 0 EndSub ' Main gane routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp ' Main loop play = 1 pause = 0 While(play = 1) ChangeDirection() Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(KeyRight = 1) Then playerAngle = Math.Remainder(playerAngle + 10, 360) EndIf If(KeyLeft = 1) Then playerAngle = Math.Remainder(playerAngle - 10, 360) EndIf If(KeyForward = 1) Then If (playerSpeed < maxSpeed) Then playerSpeed = playerSpeed + 1 EndIf EndIf If(KeyBack = 1) Then If (playerSpeed > (0 - maxSpeed)) Then playerSpeed = playerSpeed - 1 EndIf EndIf If(KeyFire = 1) Then Fire() KeyFire = 2 ' Dont register another shot until the Key is released EndIf If(KeyPause = 1) Then pause = Math.Remainder(pause + 1, 2) KeyPause = 0 EndIf If(KeyHyperspace = 1) Then Hyperspace() KeyHyperspace = 2 ' Don't register another hyperspace until key is released EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) playerSpeed = playerSpeed - (playerSpeed / 100 * drag) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then EndGame() EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextAmmoRemove = j RemoveAmmo() j = ammoMax i = i - 1 EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock If size = 60 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(bigRock)) ElseIf size = 40 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(medRock)) Else Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(smlRock)) EndIf Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 * pointsMultiply Else ' We've destroyed it - give some extra points and score = score + 5 * pointsMultiply EndIf ' Show updated score GraphicsWindow.Title = gameTitle + score ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For k = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, k, Array.GetValue(rock, k+1)) Array.SetValue(rockAngle, k, Array.GetValue(rockAngle, k+1)) Array.SetValue(rockSize, k, Array.GetValue(rockSize, k+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextAmmoRemove = 1 RemoveAmmo() EndWhile If (score >= pointsMultiply / 2) Then score = score - (pointsMultiply / 2) ' Show updated score GraphicsWindow.Title = gameTitle + score EndIf ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextAmmoRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextAmmoRemove)) For m = nextAmmoRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, m, Array.GetValue(ammo, m+1)) Array.SetValue(ammoAngle, m, Array.GetValue(ammoAngle, m+1)) Array.SetValue(ammoAge, m, Array.GetValue(ammoAge, m+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Move to a random point on screen Sub Hyperspace x = Math.GetRandomNumber(gameWidth - playerWidth) y = Math.GetRandomNumber(gameHeight - playerHeight) Shapes.Move(player, x, y) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + score + " points. Thanks for Playing.", "Game Over!") EndSub 'KeyDown Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 1 ElseIF (Key = rightKey) Then KeyRight = 1 ElseIF (Key = forwardKey) Then KeyForward = 1 ElseIF (Key = backKey) Then KeyBack = 1 ElseIF (KeyFire = 0 And Key = fireKey) Then ' Only fire if the key has been released since the last shot KeyFire = 1 ElseIF (Key = pauseKey) Then KeyPause = 1 ElseIF (KeyHyperspace = 0 And Key = hyperspaceKey) Then KeyHyperspace = 1 EndIf EndSub 'Key Up Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 0 ElseIF (Key = rightKey) Then KeyRight = 0 ElseIF (Key = forwardKey) Then KeyForward = 0 ElseIF (Key = backKey) Then KeyBack = 0 ElseIF (Key = fireKey) Then KeyFire = 0 ElseIF (Key = hyperspaceKey) Then KeyHyperspace = 0 EndIf EndSub End>QFL408-7.sb< Start>QFL408-9.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" hyperspaceKey = "H" ' Asteroid (rock) settings rockSpeed = 1 initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up maxSpeed = 10 drag = 3 ' percentage of speed lost on each screen update lives = 3 score = 0 ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" ' Game graphics bigRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_BigRock.png") medRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_MediumRock.png") smlRock = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_SmallRock.png") background = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Sky.jpg") shipImage = ImageList.LoadImage("http://smallbasic.com/drop/Asteroids_Ship.png") ' Asteroid settings graphics version. ' -- Don't change without appropriate mod to code. rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) 'Keypress flags KeyLeft = 0 KeyRight = 0 KeyForward = 0 KeyBack = 0 KeyFire = 0 KeyPause = 0 KeyHyperspace = 0 ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + score + " Lives: " + lives GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor GraphicsWindow.DrawResizedImage(background, 0, 0, gameWidth, gameHeight) LevelCheck() player = Shapes.AddImage(shipImage) Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 EndSub ' Main game routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp ' Main loop play = 1 pause = 0 While(play = 1) ChangeDirection() Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(KeyRight = 1) Then playerAngle = Math.Remainder(playerAngle + 10, 360) EndIf If(KeyLeft = 1) Then playerAngle = Math.Remainder(playerAngle - 10, 360) EndIf If(KeyForward = 1) Then If (playerSpeed < maxSpeed) Then playerSpeed = playerSpeed + 1 EndIf EndIf If(KeyBack = 1) Then If (playerSpeed > (0 - maxSpeed)) Then playerSpeed = playerSpeed - 1 EndIf EndIf If(KeyFire = 1) Then Fire() KeyFire = 2 ' Dont register another shot until the Key is released EndIf If(KeyPause = 1) Then pause = Math.Remainder(pause + 1, 2) KeyPause = 0 EndIf If(KeyHyperspace = 1) Then Hyperspace() KeyHyperspace = 2 ' Don't register another hyperspace until key is released EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) playerSpeed = playerSpeed - (playerSpeed / 100 * drag) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then If lives > 1 Then lives = lives - 1 'Show updated lives GraphicsWindow.Title = gameTitle + score + " Lives: " + lives Shapes.Remove(player) player = Shapes.AddImage(shipImage) Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 playerSpeed = 0 playerSafe = safeTime Else EndGame() Endif EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextAmmoRemove = j RemoveAmmo() j = ammoMax i = i - 1 EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock If size = 60 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(bigRock)) ElseIf size = 40 Then Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(medRock)) Else Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddImage(smlRock)) EndIf Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 * pointsMultiply Else ' We've destroyed it - give some extra points and score = score + 5 * pointsMultiply EndIf ' Show updated score GraphicsWindow.Title = gameTitle + score + " Lives: " + lives ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For k = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, k, Array.GetValue(rock, k+1)) Array.SetValue(rockAngle, k, Array.GetValue(rockAngle, k+1)) Array.SetValue(rockSize, k, Array.GetValue(rockSize, k+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextAmmoRemove = 1 RemoveAmmo() EndWhile If (score >= pointsMultiply / 2) Then score = score - (pointsMultiply / 2) ' Show updated score GraphicsWindow.Title = gameTitle + score + " Lives: " + lives EndIf ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextAmmoRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextAmmoRemove)) For m = nextAmmoRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, m, Array.GetValue(ammo, m+1)) Array.SetValue(ammoAngle, m, Array.GetValue(ammoAngle, m+1)) Array.SetValue(ammoAge, m, Array.GetValue(ammoAge, m+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Move to a random point on screen Sub Hyperspace x = Math.GetRandomNumber(gameWidth - playerWidth) y = Math.GetRandomNumber(gameHeight - playerHeight) Shapes.Move(player, x, y) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + score + " points. Thanks for Playing.", "Game Over!") EndSub 'KeyDown Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 1 ElseIF (Key = rightKey) Then KeyRight = 1 ElseIF (Key = forwardKey) Then KeyForward = 1 ElseIF (Key = backKey) Then KeyBack = 1 ElseIF (KeyFire = 0 And Key = fireKey) Then ' Only fire if the key has been released since the last shot KeyFire = 1 ElseIF (Key = pauseKey) Then KeyPause = 1 ElseIF (KeyHyperspace = 0 And Key = hyperspaceKey) Then KeyHyperspace = 1 EndIf EndSub 'Key Up Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = leftKey) Then KeyLeft = 0 ElseIF (Key = rightKey) Then KeyRight = 0 ElseIF (Key = forwardKey) Then KeyForward = 0 ElseIF (Key = backKey) Then KeyBack = 0 ElseIF (Key = fireKey) Then KeyFire = 0 ElseIF (Key = hyperspaceKey) Then KeyHyperspace = 0 EndIf EndSub End>QFL408-9.sb< Start>QFL408.sb< ' Asteroids Game ' Copyright (C) 2009, Jason T. Jacques ' License: MIT license http://www.opensource.org/licenses/mit-license.php ' Game area controls gameWidth = 640 gameHeight = 480 backColor = "black" ' Window title gameTitle = "Asteroids, Score: " ' Target frames per second fps = 25 ' Key controls leftKey = "Left" rightKey = "Right" forwardKey = "Up" backKey = "Down" fireKey = "Space" pauseKey = "P" ' Asteroid (rock) settings rockSpeed = 1 rockColor = "white" rockMin = 20 ' small size rock rockTypes = 3 ' number of rock sizes (multiples of small rock size) initRocks = 5 ' Ammo settings ammoSpeed = 5 ammoColor = "white" ammoLife = 60 ' moves before auto destruct ammoMax = 10 ammoSize = 5 ' Player settings playerColor = "white" playerHeight = 30 playerWidth = 20 safeTime = 100 ' time player has to get out of the way on level up ' Point multiplier pointsMultiply = 10 ' Array name initialisation rock = "rockArray" rockAngle = "rockAngle" rockSize = "rockSize" ammo = "ammoArray" ammoAngle = "ammoAngle" ammoAge = "ammoAge" ' Start game Init() Play() ' Setup world Sub Init GraphicsWindow.Hide() GraphicsWindow.Title = gameTitle + "0" GraphicsWindow.CanResize = false GraphicsWindow.Width = gameWidth GraphicsWindow.Height = gameHeight GraphicsWindow.BackgroundColor = backColor GraphicsWindow.BrushColor = backColor LevelCheck() GraphicsWindow.PenColor = playerColor player = Shapes.AddTriangle(playerWidth/2, 0, 0, playerHeight, playerWidth, playerHeight) Shapes.Move(player, (gameWidth - playerWidth) / 2, (gameHeight - playerHeight) / 2) playerAngle = 0 EndSub ' Main gane routine Sub Play GraphicsWindow.Show() GraphicsWindow.KeyDown = ChangeDirection ' Main loop play = 1 pause = 0 While(play = 1) Program.Delay(1000/fps) If (pause = 0) Then Move() CollisionCheck() AgeAmmo() LevelCheck() EndIf EndWhile EndSub ' Read key event and act Sub ChangeDirection If(GraphicsWindow.LastKey = rightKey) Then playerAngle = Math.Remainder(playerAngle + 10, 360) ElseIf(GraphicsWindow.LastKey = leftKey) Then playerAngle = Math.Remainder(playerAngle - 10, 360) ElseIf(GraphicsWindow.LastKey = forwardKey) Then playerSpeed = playerSpeed + 1 ElseIf(GraphicsWindow.LastKey = backKey) Then playerSpeed = playerSpeed - 1 ElseIf(GraphicsWindow.LastKey = fireKey) Then Fire() ElseIf(GraphicsWindow.LastKey = pauseKey) Then pause = Math.Remainder(pause + 1, 2) EndIf Shapes.Rotate(player, playerAngle) EndSub ' Move all on screen items Sub Move ' Move player x = Math.Remainder(Shapes.GetLeft(player) + (Math.Cos(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(player) + (Math.Sin(Math.GetRadians(playerAngle - 90)) * playerSpeed) + gameHeight, gameHeight) Shapes.Move(player, x, y) ' Move rocks For i = 1 To Array.GetItemCount(rock) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(rock, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(rock, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(rockAngle, i) - 90)) * rockSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(rock, i), x, y) EndFor ' Move ammo For i = 1 To Array.GetItemCount(ammo) x = Math.Remainder(Shapes.GetLeft(Array.GetValue(ammo, i)) + (Math.Cos(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameWidth, gameWidth) y = Math.Remainder(Shapes.GetTop(Array.GetValue(ammo, i)) + (Math.Sin(Math.GetRadians(Array.GetValue(ammoAngle, i) - 90)) * ammoSpeed) + gameHeight, gameHeight) Shapes.Move(Array.GetValue(ammo, i), x, y) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i) + 1) EndFor EndSub ' Check for collisions between onscreen items Sub CollisionCheck ' Calculate player bounding box. px1 = Shapes.GetLeft(player) - ( (Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) - playerWidth) / 2) py1 = Shapes.GetTop(player) - ( (Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) - playerHeight) / 2) px2 = px1 + Math.Abs(playerWidth * Math.Cos(Math.GetRadians(playerAngle)) + playerHeight * Math.Sin(Math.GetRadians(playerAngle))) py2 = py1 + Math.Abs(playerWidth * Math.Sin(Math.GetRadians(playerAngle)) + playerHeight * Math.Cos(Math.GetRadians(playerAngle))) ' Re-order co-oridinates if they are the wrong way arround If(px1 > px2) Then tmp = px1 px1 = px2 px2 = tmp EndIf If(py1 > py2) Then tmp = py1 py1 = py2 py2 = tmp EndIf ' Check if each rock has hit something For i = 1 To Array.GetItemCount(rock) ax1 = Shapes.Getleft(Array.GetValue(rock, i)) ay1 = Shapes.GetTop(Array.GetValue(rock, i)) ax2 = ax1 + Array.GetValue(rockSize, i) ay2 = ay1 + Array.GetValue(rockSize, i) ' Player collison If(playerSafe < 1) Then If ( (ax1 < px1 And ax2 > px1) Or (ax1 < px2 And ax2 > px2) ) Then If ( (ay1 < py1 And ay2 > py1) Or (ay1 < py2 And ay2 > py2) ) Then EndGame() EndIf EndIf EndIf ' Ammo collison For j = 1 to Array.GetItemCount(ammo) bx1 = Shapes.Getleft(Array.GetValue(ammo, j)) by1 = Shapes.GetTop(Array.GetValue(ammo, j)) bx2 = bx1 + ammoSize by2 = by1 + ammoSize If ( (ax1 < bx1 And ax2 > bx1) Or (ax1 < bx2 And ax2 > bx2) ) Then If ( (ay1 < by1 And ay2 > by1) Or (ay1 < by2 And ay2 > by2) ) Then nextRemove = i RemoveRock() nextRemove = j RemoveAmmo() EndIf EndIf EndFor EndFor ' Decrease the time player is safe If (playerSafe > 0) Then playerSafe = playerSafe - 1 EndIf EndSub ' Add a new rock to the world Sub AddRock ' Check if the next rock size/position has been specified If (nextSize <> 0) Then size = rockMin* nextSize x = Shapes.GetLeft(nextPosition) y = Shapes.GetTop(nextPosition) nextSize = 0 Else ' Choose a random size and position size = rockMin * Math.GetRandomNumber(rockTypes) x = Math.GetRandomNumber(gameWidth - size) y = Math.GetRandomNumber(gameHeight - size) EndIf ' Draw the rock GraphicsWindow.PenColor = rockColor Array.SetValue(rock, (Array.GetItemCount(rock) + 1), Shapes.AddEllipse(size, size)) Shapes.Move(Array.GetValue(rock, Array.GetItemCount(rock)), x, y) Array.SetValue(rockAngle, Array.GetItemCount(rock), Math.GetRandomNumber(360)) Array.SetValue(rockSize, Array.GetItemCount(rock), size) EndSub ' Remove a rock from the world and update score Sub RemoveRock removeSize = Array.GetValue(rockSize, nextRemove) / rockMin ' If not a mini rock If (removeSize > 1) Then ' ... add new rocks until we have made up for it being broken apart... While(removeSize > 0) nextSize = Math.GetRandomNumber(removeSize - 1) nextPosition = Array.GetValue(rock, nextRemove) removeSize = removeSize - nextSize AddRock() EndWhile ' And give a point for a 'hit' score = score + 1 Else ' We've destroyed it - give some extra points and score = score + 5 EndIf ' Show updated score GraphicsWindow.Title = gameTitle + (score * pointsMultiply) ' Remove all references from the arrays Shapes.Remove(Array.GetValue(rock, nextRemove)) For i = nextRemove To (Array.GetItemCount(rock) - 1) Array.SetValue(rock, i, Array.GetValue(rock, i+1)) Array.SetValue(rockAngle, i, Array.GetValue(rockAngle, i+1)) Array.SetValue(rockSize, i, Array.GetValue(rockSize, i+1)) EndFor Array.RemoveValue(rock, Array.GetItemCount(rock)) Array.RemoveValue(rockAngle, Array.GetItemCount(rockAngle)) Array.RemoveValue(rockSize, Array.GetItemCount(rockSize)) EndSub ' Check if the player has completed the level, if so, level up Sub LevelCheck If(Array.GetItemCount(rock) < 1) Then nextSize = 0 For i = 1 To initRocks AddRock() EndFor initRocks = initRocks + 1 ' Give players some time to move out of the way playerSafe = safeTime EndIf EndSub ' Add ammo to game Sub Fire ' Remove additional ammo While(Array.GetItemCount(ammo) > (ammoMax - 1)) nextRemove = 1 RemoveAmmo() EndWhile ' Add the ammo GraphicsWindow.PenColor = ammoColor Array.SetValue(ammo, (Array.GetItemCount(ammo) + 1), Shapes.AddEllipse(ammoSize, ammoSize)) Shapes.Move(Array.GetValue(ammo, Array.GetItemCount(ammo)), (px1 + px2 - ammoSize) / 2, (py1 + py2 - ammoSize) / 2) Array.SetValue(ammoAngle, Array.GetItemCount(ammo), playerAngle) EndSub ' Check ammo age Sub AgeAmmo While (Array.GetValue(ammoAge, 1) > ammoLife) nextRemove = 1 RemoveAmmo() EndWhile EndSub ' Remove top Ammo Sub RemoveAmmo Shapes.Remove(Array.GetValue(ammo, nextRemove)) For i = nextRemove To (Array.GetItemCount(ammo) - 1) Array.SetValue(ammo, i, Array.GetValue(ammo, i+1)) Array.SetValue(ammoAngle, i, Array.GetValue(ammoAngle, i+1)) Array.SetValue(ammoAge, i, Array.GetValue(ammoAge, i+1)) EndFor Array.RemoveValue(ammo, Array.GetItemCount(ammo)) Array.RemoveValue(ammoAngle, Array.GetItemCount(ammoAngle)) Array.RemoveValue(ammoAge, Array.GetItemCount(ammoAge)) EndSub ' Display simple end game message box Sub EndGame play = 0 Shapes.Remove(player) GraphicsWindow.ShowMessage("You scored " + (score * pointsMultiply) + " points. Thanks for Playing.", "Game Over!") EndSub End>QFL408.sb< Start>QFN976-0.sb< MW = GraphicsWindow.Width / 2 MH = GraphicsWindow.Height / 2 T = "True" F = "False" h1[1] = "number" h1[2] = " text " dv1 = LDControls.AddDataView(MW - 5, MH - 30, h1) Shapes.Move(dv1, 5, 5) h2[1] = " text " h2[2] = " total " dv2 = LDControls.AddDataView(MW - 15, MH - 30 , h2) Shapes.Move(dv2, MW + 10, 5) LDControls.DataViewAllowSort(dv2, T) LDControls.DataViewAllowUserEntry(dv2, F) LDControls.DataViewCellValueChanged = OnDataViewCellValueChanged While 1 = 1 If DVCVC = 1 Then DVCVC = 0 changed = LDControls.LastDataViewCellValueChanged ReadChangedRow = LDControls.DataViewGetRow(dv1, changed[1]) NE = 0 if ReadChangedRow[1] <> "" And ReadChangedRow[2] <> "" Then NE = 2 For ii = 1 To LDControls.DataViewRowCount(dv2) TextWindow.WriteLine("ii "+ii) If ReadChangedRow[2] = LDControls.DataViewGetValue(dv2, ii, 1) Then dv2Number = LDControls.DataViewGetValue(dv2, ii, 2) OldRow = ii NE = NE + 1 EndIf EndFor TextWindow.WriteLine("NE "+NE) If NE = 2 Then NewRow = LDControls.DataViewRowCount(dv2) + 1 RowValue[1] = ReadChangedRow[2] RowValue[2] = ReadChangedRow[1] LDControls.DataViewSetRow(dv2, NewRow, RowValue) NE = NE + 10 ElseIf NE = 3 Then LDControls.DataViewSetValue(dv2, OldRow, 2, ReadChangedRow[2] + dv2Number) NE = NE + 10 EndIf EndIf EndIf EndWhile Sub OnDataViewSelectionChanged TextWindow.WriteLine("OnDataViewSelectionChanged") selected = LDControls.DataViewGetSelected(dv1) For i = 1 To Array.GetItemCount(selected) data = LDControls.DataViewGetValue(dv1,selected[i][1],selected[i][2]) TextWindow.WriteLine("Markiert wurde Zeile: "+selected[i][1]+" Spalte: "+selected[i][2]+" Inhalt: "+data) EndFor EndSub Sub OnDataViewCellValueChanged TextWindow.WriteLine("OnDataViewCellValueChanged") DVCVC = 1 EndSub End>QFN976-0.sb< Start>QFN976.sb< MW = GraphicsWindow.Width / 2 MH = GraphicsWindow.Height / 2 T = "True" F = "False" h1[1] = "number" h1[2] = " text " dv1 = LDControls.AddDataView(MW - 5, MH - 30, h1) Shapes.Move(dv1, 5, 5) h2[1] = " text " h2[2] = " total " dv2 = LDControls.AddDataView(MW - 15, MH - 30 , h2) Shapes.Move(dv2, MW + 10, 5) LDControls.DataViewAllowSort(dv2, T) LDControls.DataViewAllowUserEntry(dv2, F) LDControls.DataViewCellValueChanged = OnDataViewCellValueChanged While 1 = 1 If DVCVC = 1 Then DVCVC = 0 changed = LDControls.LastDataViewCellValueChanged ReadChangedRow = LDControls.DataViewGetRow(dv1, changed[1]) NE = 0 if ReadChangedRow[1] <> "" And ReadChangedRow[2] <> "" Then NE = 2 For ii = 1 To LDControls.DataViewRowCount(dv2) If ReadChangedRow[2] = LDControls.DataViewGetValue(dv2, ii, 1) Then dv2Number = LDControls.DataViewGetValue(dv2, ii, 2) OldRow = ii NE = NE + 1 EndIf EndFor If NE = 2 Then NewRow = LDControls.DataViewRowCount(dv2) + 1 RowValue[1] = ReadChangedRow[2] RowValue[2] = ReadChangedRow[1] LDControls.DataViewSetRow(dv2, NewRow, RowValue) NE = NE + 10 ElseIf NE = 3 Then LDControls.DataViewSetValue(dv2, OldRow, 2, ReadChangedRow[2] + dv2Number) NE = NE + 10 EndIf EndIf EndIf EndWhile Sub OnDataViewSelectionChanged selected = LDControls.DataViewGetSelected(dv1) For i = 1 To Array.GetItemCount(selected) data = LDControls.DataViewGetValue(dv1,selected[i][1],selected[i][2]) TextWindow.WriteLine("Markiert wurde Zeile: "+selected[i][1]+" Spalte: "+selected[i][2]+" Inhalt: "+data) EndFor EndSub Sub OnDataViewCellValueChanged DVCVC = 1 EndSub End>QFN976.sb< Start>QFP944-0.sb< varname = Controls.AddMultiLineTextBox(10,10) Controls.SetSize(varname, 130, 130) buttonsave = Controls.AddButton("Save",10,150) buttonopen = Controls.AddButton("Open",10,190) Controls.ButtonClicked = OnButtonClicked Sub OnButtonClicked If (Controls.LastClickedButton = buttonsave) Then ' The following line could be harmful and has been automatically commented. ' File.WriteContents(varopenlocation, Controls.GetTextBoxText(varname)) EndIf If (Controls.LastClickedButton = buttonopen) Then varopenlocation = Dialogs.AskForFile("All Files (*.) |*.*") ' The following line could be harmful and has been automatically commented. ' Controls.SetTextBoxText(varname, File.ReadContents(varopenlocation)) EndIf EndSub End>QFP944-0.sb< Start>QFP944-2.sb< filetoopen = Program.GetArgument(1) varname = Controls.AddMultiLineTextBox(10,10) Controls.SetSize(varname, 300, 300) buttonsave = Controls.AddButton("Save",10,320) buttonsaveas = Controls.AddButton("Save As",10,360) buttonopen = Controls.AddButton("Open",10,400) Controls.ButtonClicked = OnButtonClicked If filetoopen <> "" Then varopenlocation = filetoopen ' The following line could be harmful and has been automatically commented. ' Controls.SetTextBoxText(varname, File.ReadContents(varopenlocation)) EndIf Sub OnButtonClicked If (Controls.LastClickedButton = buttonsave) Then ' The following line could be harmful and has been automatically commented. ' File.WriteContents(varopenlocation, Controls.GetTextBoxText(varname)) EndIf If (Controls.LastClickedButton = buttonopen) Then varopenlocation2 = Dialogs.AskForFile("Text Files (*.txt)|*.txt") If varopenlocation2 <> "" Then varopenlocation = varopenlocation2 ' The following line could be harmful and has been automatically commented. ' Controls.SetTextBoxText(varname, File.ReadContents(varopenlocation)) EndIf EndIf If (Controls.LastClickedButton = buttonsaveas) Then varopenlocation2 = Dialogs.AskForSaveLocation("Text Files (*.txt)|*.txt", "True") If varopenlocation2 <> "" Then varopenlocation = varopenlocation2 ' The following line could be harmful and has been automatically commented. ' File.WriteContents(varopenlocation, Controls.GetTextBoxText(varname)) EndIf EndIf EndSub End>QFP944-2.sb< Start>QFP944.sb< varname = Controls.AddTextBox(10,10) buttonsave = Controls.AddButton("Save",10,50) buttonopen = Controls.AddButton("Open",10,90) Controls.ButtonClicked = OnButtonClicked Sub OnButtonClicked If (Controls.LastClickedButton = buttonsave) Then varsavelocation = Dialogs.AskForSaveLocation("All Files (*.*) |*.*","True") EndIf If (Controls.LastClickedButton = buttonopen) Then varopenlocation = Dialogs.AskForFile("All Files (*.) |*.*") EndIf EndSub End>QFP944.sb< Start>QFR136.sb< Draw[1]="x=10;y=10;width=40;heigth=80" Draw[2]="x=50;y=80;width=40;heigth=80" Draw[3]="x=100;y=150;width=100;heigth=70" GraphicsWindow.DrawRectangle(Draw[1]["x"],Draw[1]["y"],Draw[1]["width"],Draw[1]["heigth"]) GraphicsWindow.DrawEllipse(Draw[2]["x"],Draw[2]["y"],Draw[2]["width"],Draw[2]["heigth"]) GraphicsWindow.fillRectangle(Draw[3]["x"],Draw[3]["y"],Draw[3]["width"],Draw[3]["heigth"]) End>QFR136.sb< Start>QFR228.sb< Image = Program.Directory+"\imhappyplz.txt" ' The following line could be harmful and has been automatically commented. ' Image_Height = File.ReadLine(Image,1) ' The following line could be harmful and has been automatically commented. ' Image_Width = File.ReadLine(Image,2) While "True" TextWindow.WriteLine("Type in the Zoom factor:") Zoom = TextWindow.ReadNumber() Line = 2 For Y = 0 To Image_Width*Zoom Step Zoom For X = 0 To Image_Height*Zoom Step Zoom Line = Line + 1 ' The following line could be harmful and has been automatically commented. ' GraphicsWindow.SetPixel(X,Y,File.ReadLine(Image,Line)) endfor endfor endwhile End>QFR228.sb< Start>QFW038.sb< 'GUI Design, by Airwaves! GraphicsWindow.Show() GraphicsWindow.MouseMove = MouseMove GraphicsWindow.Title = "GUI Designer" dialog_filepath = Program.Directory + "\" 'your program filepath with extension (.smallbasic) addbutton_button = FCControls.AddButton(70, 20, "Add Button") FCControls.Move(addbutton_button, GraphicsWindow.Width - 73, GraphicsWindow.Height - 60) FCControls.RegisterMouseDownEvent(addbutton_button, "addbutton") done_button = FCControls.AddButton(70, 20, "Done") FCControls.Move(done_button, GraphicsWindow.Width - 146, GraphicsWindow.Height - 60) FCControls.RegisterMouseDownEvent(done_button, "done") currentselected = "" stuff() Sub addbutton buttonnumber = buttonnumber + 1 button[buttonnumber] = FCControls.AddButton(80, 30, "Button " + buttonnumber) FCControls.RegisterMouseDownEvent(button[buttonnumber], "setselected") EndSub Sub setposition FCControls.Move(currentselected, FCControls.GetText(x_box), FCControls.GetText(y_box)) EndSub Sub stuff x_box = FCControls.AddTextBox(90, 25, "X") y_box = FCControls.AddTextBox(90, 25, "Y") register_box = FCControls.AddTextBox(90, 25, "Register") width_box = FCControls.AddTextBox(90, 25, "Width") height_box = FCControls.AddTextBox(90, 25, "Height") FCControls.Move(x_box, GraphicsWindow.Width - 190, 5) FCControls.Move(width_box, GraphicsWindow.Width - 190, 65) FCControls.Move(height_box, GraphicsWindow.Width - 95, 65) FCControls.Move(y_box, GraphicsWindow.Width - 95, 5) FCControls.Move(register_box, GraphicsWindow.Width - 190, 35) FCControls.RegisterKeyDownEvent(x_box, "setposition") FCControls.RegisterKeyDownEvent(y_box, "setposition") FCControls.RegisterKeyDownEvent(register_box, "setregister") FCControls.RegisterKeyDownEvent(width_box, "setwidth") FCControls.RegisterKeyDownEvent(height_box, "setheight") GraphicsWindow.BrushColor = "Black" currentselected2 = Shapes.AddText("Focus:") Shapes.Move(currentselected2, GraphicsWindow.Width - 95, 35) EndSub Sub setselected mX = GraphicsWindow.MouseX mY = GraphicsWindow.MouseY For i = 0 To Array.GetItemCount(button) buttonleft = FCControls.GetLeft(button[i]) buttonright = FCControls.GetRight(button[i]) buttontop = FCControls.GetTop(button[i]) buttonbottom = FCControls.GetBottom(button[i]) If mX>buttonleft And mXbuttontop And mYQFW038.sb< Start>QFW203.sb< ' Klassic Soccer Ball ' mhreen miangul 'JuLy 2018 GraphicsWindow.Width = 800 GraphicsWindow.height = 600 GraphicsWindow.BackgroundColor = "snow 'Makesprite() SPRITE_init() ' <--------- all shape data is input here!! add_shapes() ' <--------- all shapes are added here!! ' Add Sprites Sub add_shapes For M=1 to Array.GetItemCount(s) ' 6 types shapes // BlueCar, Trees , House , Apple , Aircraft , Ladder3D/ For N=1 to Array.GetItemCount(s[M]) ' repeat number //BlueCar=1 , Trees =14 , House=1 , Apple=18 , Aircraft=1 , Ladder3D=1// ss=s[M][N] ' scale _shx=shx[M][N] ' base point _X _shY=shY[M][N] ' base point _Y _shape=shape[M] ' temporary shape data NMB=M+":"+N ' shape index for i=1 To Array.GetItemCount(_shape) GraphicsWindow.PenWidth = _shape[i]["pw"] GraphicsWindow.BrushColor = _shape[i]["bc"] GraphicsWindow.penColor = _shape[i]["pc"] If _shape[i]["func"]="ell" Then shp[NMB][i] = Shapes.AddEllipse(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="rect" Then shp[NMB][i] = Shapes.AddRectangle(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="tri" Then shp[NMB][i] = Shapes.Addtriangle(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss, _shape[i]["x3"]*ss, _shape[i]["y3"]*ss) ElseIf _shape[i]["func"]="line" Then shp[NMB][i] = Shapes.Addline(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss) EndIf Shapes.Animate(shp[NMB][i], _shape[i]["x"]*ss+_shX, _shape[i]["y"]*ss+_shY, 500) Shapes.Rotate(shp[NMB][i], _Shape[i]["angle"]) EndFor endfor endfor EndSub Sub SPRITE_init ' 1 Klassic Football 1 Black White 1 S 1 s[1] ="1=0.5" ' scale shx[1] ="1=0" ' initial x -position shy[1] ="1=0" ' initial y-position shape[1][1]="func=rect;X=455;Y=510;width=4;height=45;angle=-117;bc=black;pc=black;pw=0" shape[1][2]="func=rect;X=433;Y=500;width=4;height=45;angle=-180;bc=black;pc=black;pw=0" shape[1][3]="func=rect;X=453;Y=404;width=4;height=100;angle=25;bc=black;pc=black;pw=0" shape[1][4]="func=rect;X=490;Y=370;width=4;height=45;angle=50;bc=black;pc=black;pw=0" shape[1][5]="func=rect;X=516;Y=377;width=4;height=45;angle=160;bc=black;pc=black;pw=0" shape[1][6]="func=rect;X=500;Y=417;width=4;height=110;angle=-155;bc=black;pc=black;pw=0" ' 2 Klassic Football 2 Black White 2 S 2 s[2] ="1=0.5" ' scale shx[2] ="1=0" ' initial x -position shy[2] ="1=0" ' initial y-position shape[2][1]="func=rect;X=535;Y=322;width=4;height=80;angle=60;bc=black;pc=black;pw=0" shape[2][2]="func=rect;X=610;Y=300;width=4;height=80;angle=90;bc=black;pc=black;pw=0" shape[2][3]="func=rect;X=661;Y=337;width=4;height=55;angle=-17;bc=black;pc=black;pw=0" shape[2][4]="func=rect;X=620;Y=355;width=4;height=100;angle=70;bc=black;pc=black;pw=0" shape[2][5]="func=rect;X=547;Y=397;width=4;height=50;angle=-90;bc=black;pc=black;pw=0" ' 3 Klassic Football 3 Black White 3 S 3 s[3]="1=0.5" shX[3]="1=0" shY[3]="1=0" shape[3][1]="func=rect;X=697;Y=300;width=4;height=80;angle=90;bc=black;pc=black;pw=0" shape[3][2]="func=rect;X=777;Y=318;width=4;height=92;angle=122;bc=black;pc=black;pw=0" shape[3][3]="func=rect;X=718;Y=357;width=4;height=100;angle=110;bc=black;pc=black;pw=0" shape[3][4]="func=rect;X=790;Y=377;width=4;height=60;angle=55;bc=black;pc=black;pw=0" ' 4 Klassic Football 4 Black White 4 S 4 s[4]="1=0.5" shX[4]="1=0" shY[4]="1=0" shape[4][1]="func=rect;X=844;Y=377;width=4;height=80;angle=135;bc=black;pc=black;pw=0" shape[4][2]="func=rect;X=780;Y=420;width=4;height=70;angle=155;bc=black;pc=black;pw=0" shape[4][3]="func=rect;X=877;Y=442;width=4;height=80;angle=170;bc=black;pc=black;pw=0" shape[4][4]="func=rect;X=865;Y=513;width=4;height=40;angle=50;bc=black;pc=black;pw=0" shape[4][5]="func=rect;X=820;Y=478;width=4;height=80;angle=-42;bc=black;pc=black;pw=0" ' 5 Klassic Football 5 Black White 5 S 5 s[5] ="1=0.5" ' scale shx[5] ="1=0" ' initial x -position shy[5] ="1=0" ' initial y-position shape[5][1]="func=rect;X=885;Y=524;width=4;height=45;angle=-5;bc=black;pc=black;pw=0" shape[5][2]="func=rect;X=880;Y=569;width=4;height=80;angle=10;bc=black;pc=black;pw=0" shape[5][3]="func=rect;X=860;Y=645;width=4;height=45;angle=30;bc=black;pc=black;pw=0" shape[5][4]="func=rect;X=833;Y=650;width=4;height=42;angle=-34;bc=black;pc=black;pw=0" shape[5][5]="func=rect;X=835;Y=548;width=4;height=105;angle=12;bc=black;pc=black;pw=0" ' 6 Klassic Football 6 Black White 6 S 6 s[6] ="1=0.5" ' scale shx[6] ="1=0" ' initial x -position shy[6] ="1=0" ' initial y-position shape[6][1]="func=rect;X=824;Y=680;width=4;height=80;angle=40;bc=black;pc=black;pw=0" shape[6][2]="func=rect;X=752;Y=720;width=4;height=100;angle=70;bc=black;pc=black;pw=0" shape[6][3]="func=rect;X=778;Y=625;width=4;height=100;angle=70;bc=black;pc=black;pw=0" shape[6][4]="func=rect;X=684;Y=735;width=4;height=60;angle=-40;bc=black;pc=black;pw=0" shape[6][5]="func=rect;X=700;Y=670;width=4;height=90;angle=-124;bc=black;pc=black;pw=0" ' 7 Klassic Football 7 Black White 7 S 7 s[7] ="1=0.5" ' scale shx[7] ="1=0" ' initial x -position shy[7] ="1=0" ' initial y-position shape[7][1]="func=rect;X=635;Y=718;width=4;height=130;angle=95;bc=black;pc=black;pw=0" shape[7][2]="func=rect;X=597;Y=630;width=4;height=150;angle=120;bc=black;pc=black;pw=0" shape[7][3]="func=rect;X=523;Y=680;width=4;height=120;angle=125;bc=black;pc=black;pw=0" shape[7][4]="func=rect;X=500;Y=653;width=4;height=70;angle=63;bc=black;pc=black;pw=0" ' 8 Klassic Football 8 Black White 8 S 8 s[8] ="1=0.5" ' scale shx[8] ="1=0" ' initial x -position shy[8] ="1=0" ' initial y-position shape[8][1]="func=rect;X=430;Y=540;width=4;height=100;angle=0;bc=black;pc=black;pw=0" shape[8][2]="func=rect;X=495;Y=520;width=4;height=80;angle=150;bc=black;pc=black;pw=0" shape[8][3]="func=rect;X=450;Y=630;width=4;height=80;angle=-30;bc=black;pc=black;pw=0" shape[8][4]="func=rect;X=524;Y=593;width=4;height=80;angle=-15;bc=black;pc=black;pw=0" ' 9 Klassic Football 9 Black White 9 C 12345 s[9] ="1=0.5" ' scale shx[9] ="1=0" ' initial x -position shy[9] ="1=0" ' initial y-position shape[9][1]="func=rect;X=560;Y=510;width=4;height=110;angle=60;bc=black;pc=black;pw=0" shape[9][2]="func=rect;X=600;Y=420;width=4;height=120;angle=-8;bc=black;pc=black;pw=0" shape[9][3]="func=rect;X=660;Y=490;width=4;height=100;angle=90;bc=black;pc=black;pw=0" shape[9][4]="func=rect;X=753;Y=470;width=4;height=95;angle=60;bc=black;pc=black;pw=0" shape[9][5]="func=rect;X=730;Y=538;width=4;height=150;angle=-5;bc=black;pc=black;pw=0" endsub End>QFW203.sb< Start>QFW939.sb< ''Challenge of the Month April 2020 third drawing '' WhTurner 2020-04-13 (KRR126 turtle version) '' 2020-04-20 quick DrawLine version. gw=800 gh=800 gw2=gw/2 ''center gh2=gh/2 GraphicsWindow.Width=gw GraphicsWindow.Height=gh GraphicsWindow.PenWidth=1 l=300 ''radius of pattern For h=0 To 359 Step 6 xx=gw2+LDMath.Sin(h)*l yy=gh2-LDMath.Cos(h)*l GraphicsWindow.DrawLine(gw2,gh2,xx,yy) p3=l*0.37 ''position inside arrows l3=l*0.3 dh=3 x2=gw2+LDMath.Sin(h)*p3 '' y2=gh2-LDMath.Cos(h)*p3 x3=gw2+LDMath.Sin(h+dh)*l3 y3=gh2-LDMath.Cos(h+dh)*l3 GraphicsWindow.DrawLine(x2,y2,x3,y3) x3=gw2+LDMath.Sin(h-dh)*l3 y3=gh2-LDMath.Cos(h-dh)*l3 GraphicsWindow.DrawLine(x2,y2,x3,y3) p2=l*0.73 ''outside arrows l2=l*0.80 dh=1.0 x2=gw2+LDMath.Sin(h)*p2 y2=gh2-LDMath.Cos(h)*p2 x3=gw2+LDMath.Sin(h+dh)*l2 y3=gh2-LDMath.Cos(h+dh)*l2 GraphicsWindow.DrawLine(x2,y2,x3,y3) x3=gw2+LDMath.Sin(h-dh)*l2 y3=gh2-LDMath.Cos(h-dh)*l2 GraphicsWindow.DrawLine(x2,y2,x3,y3) For s=1 To 2 ''stars If s=1 Then '' inner j=0.53 l2=0.2*l Else j=1 ''outer l2=0.1*l EndIf p2=l*j ''position center xx=gw2+LDMath.Sin(h)*p2 yy=gh2-LDMath.Cos(h)*p2 For iss=0 To 359 Step 24 x2=xx+LDMath.Sin(iss)*l2 y2=yy-LDMath.Cos(iss)*l2 GraphicsWindow.DrawLine(xx,yy,x2,y2) EndFor EndFor EndFor ''h End>QFW939.sb< Start>QFX561.sb< 'Story Beginner main: TextWindow.Title="StoryIdeas v1.0" TextWindow.ForegroundColor="Red" TextWindow.WriteLine("Welcome to StoryIdeas v1.0!") TextWindow.WriteLine("---------------------------") TextWindow.WriteLine("Please type in an adjective: ") ad1=textwindow.Read() TextWindow.WriteLine("Please type in an adjective: ") ad2=textwindow.Read() TextWindow.WriteLine("Please type in an adjective: ") ad3=textwindow.Read() TextWindow.WriteLine("Please type in an adjective: ") ad4=textwindow.Read() TextWindow.WriteLine("Please type in a noun: ") no1=textwindow.Read() TextWindow.WriteLine("Please type in a noun: ") no2=textwindow.Read() TextWindow.WriteLine("Please type in a noun: ") no3=textwindow.Read() TextWindow.WriteLine("Please type in a name of a place: ") pla1=textwindow.Read() TextWindow.Clear() TextWindow.WriteLine("Here is your story idea!") TextWindow.WriteLine("------------------------") TextWindow.WriteLine("One "+ad1+" day, in "+pla1+" there was a "+ad2+" "+no1+" that did not want to be a "+no1+" anymore.") TextWindow.WriteLine("So one "+ad3+" "+no2+", the "+no1+" left "+pla1+" to try to find a "+ad4+" "+no3) TextWindow.WriteLine("------------------------------------------------------------------------") TextWindow.WriteLine("Done? [y][n] ") answer=textwindow.Read() If answer=("y") Then Program.End() Else If answer=("n") Then Goto main EndIf endIf End>QFX561.sb< Start>QGB341.sb< TextWindow.Title = "Black Jack V1.0" TextWindow.BackgroundColor = "white" TextWindow.ForegroundColor = "black" TextWindow.Clear() TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" Welcome, this is Black Jack!") TextWindow.WriteLine("") TextWindow.WriteLine(" By The Hacker") TextWindow.PauseWithoutMessage() TextWindow.Clear() Start() Sub Start TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" The Game Will Now Begin") TextWindow.PauseWithoutMessage() TextWindow.Clear() TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" Please enter your name") Players["Player"] = TextWindow.Read() Players["Dealer"] = "Dealer" TextWindow.Clear() Players["Player"]["Money"] = 1000 Players["Dealer"]["Money"] = 1000 Players["Player"]["CardCount"] = 0 Players["Dealer"]["CardCount"] = 0 TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" Press any key to begin") TextWindow.PauseWithoutMessage() TextWindow.Clear() Deal() EndSub Sub Deal Players["Player"]["CardCount"] = 2 Players["Player"]["Cards"][1] = Math.GetRandomNumber(13) Players["Player"]["Cards"][2] = Math.GetRandomNumber(13) Players["Dealer"]["CardCount"] = 2 Players["Dealer"]["Cards"][1] = Math.GetRandomNumber(13) Players["Dealer"]["Cards"][2] = Math.GetRandomNumber(13) Players["Player"]["Total"] = Players["Player"]["Cards"][1] + Players["Player"]["Cards"][2] Players["Dealer"]["Total"] = Players["dealer"]["Cards"][1] + Players["Dealer"]["Cards"][2] 'If(Players["Player"]["Cards"][1] = 11)Then ' Players["Player"]["Cards"][1] = "Jack" 'ElseIf(Players["Player"]["Cards"][1] = 12)Then ' Players["Player"]["Cards"][1] = "Queen" 'ElseIf(Players["Player"]["Cards"][1] = 13)Then ' Players["Player"]["Cards"][1] = "King" 'Elseif(Players["Player"]["Cards"][1] = 1)Then ' Players["Player"]["Cards"][1] = "Ace" 'EndIf ' If(Players["Player"]["Cards"][2] = 11)Then ' Players["Player"]["Cards"][2] = "Jack" ' ElseIf(Players["Player"]["Cards"][2] = 12)Then ' Players["Player"]["Cards"][2] = "Queen" ' ElseIf(Players["Player"]["Cards"][2] = 13)Then ' Players["Player"]["Cards"][2] = "King" ' Elseif(Players["Player"]["Cards"][2] = 1)Then ' Players["Player"]["Cards"][2] = "Ace" ' EndIf ' If(Players["Dealer"]["Cards"][1] = 11)Then ' Players["Dealer"]["Cards"][1] = "Jack" ' ElseIf(Players["Dealer"]["Cards"][1] = 12)Then ' Players["Dealer"]["Cards"][1] = "Queen" ' ElseIf(Players["Dealer"]["Cards"][1] = 13)Then ' Players["Dealer"]["Cards"][1] = "King" ' Elseif(Players["Dealer"]["Cards"][1] = 1)Then ' Players["Dealer"]["Cards"][1] = "Ace" ' EndIf ' If(Players["Dealer"]["Cards"][2] = 11)Then ' Players["Dealer"]["Cards"][2] = "Jack" ' ElseIf(Players["Dealer"]["Cards"][2] = 12)Then ' Players["Dealer"]["Cards"][2] = "Queen" ' ElseIf(Players["Dealer"]["Cards"][2] = 13)Then ' Players["Dealer"]["Cards"][2] = "King" ' Elseif(Players["Dealer"]["Cards"][2] = 1)Then ' Players["Dealer"]["Cards"][2] = "Ace" 'EndIf TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" The Cards Have Been Dealt") TextWindow.PauseWithoutMessage() TextWindow.Clear() CardCount() EndSub Sub CardCount TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" Your Cards: " + Players["Player"]["Cards"][1] + ", " + Players["Player"]["Cards"][2] + ", " + Players["Player"]["Cards"][3] + ", " + Players["Player"]["Cards"][4] + ", " + Players["Player"]["Cards"][5] ) TextWindow.WriteLine(" Your Total: " + Players["Player"]["Total"]) TextWindow.PauseWithoutMessage() HitorStay() EndSub Sub HitorStay If(Players["Player"]["Total"] > 21)Then TextWindow.WriteLine("You Bust Dealer Wins!") TextWindow.PauseWithoutMessage() Program.End() Else TextWindow.WriteLine(" Would you like to hit or stay? Press 1 for hit and 2 for stay") HitStay = TextWindow.ReadNumber() If(HitStay = 1)Then Hit() ElseIf(HitStay = 2)Then Stay() Else TextWindow.Clear() TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine("") TextWindow.WriteLine(" Please use correct input number") TextWindow.PauseWithoutMessage() TextWindow.Clear() CardCount() EndIf EndIf Endsub Sub Hit If(Players["Player"]["CardCount"] >= 5)Then TextWindow.WriteLine(" Max Card Limit Reached") CardCount() Else Players["Player"]["CardCount"] = Players["Player"]["CardCount"] + 1 Card = Players["Player"]["CardCount"] Players["Player"]["Cards"][Card] = Math.GetRandomNumber(13) Players["Player"]["Total"] = Players["Player"]["Cards"][1] + Players["Player"]["Cards"][2] + Players["Player"]["Cards"][3] + Players["Player"]["Cards"][4] + Players["Player"]["Cards"][5] CardCount() EndIf EndSub Sub Stay If(Players["Dealer"]["Total"] < 17)Then DealerHit() ElseIf(Players["Dealer"]["Total"] > 21)Then TextWindow.WriteLine(" Dealer Bust! You Win") Program.End() Else EndCount() EndIf EndSub Sub DealerHit If(Players["Dealer"]["CardCount"] >= 5)Then EndCount() Else Players["Dealer"]["CardCount"] = Players["Dealer"]["CardCount"] + 1 Players["Dealer"]["Cards"][Card] = Math.GetRandomNumber(13) Players["Dealer"]["Total"] = Players["Dealer"]["Cards"][1] + Players["Dealer"]["Cards"][2] + Players["Dealer"]["Cards"][3] + Players["Dealer"]["Cards"][4] + Players["Dealer"]["Cards"][5] EndIf EndSub Sub EndCount If(Players["Player"]["Total"] > Players["Dealer"]["Total"])Then TextWindow.Clear() TextWindow.WriteLine(" Condradulations! You win!") Else TextWindow.Clear() TextWindow.WriteLine(" Sorry! You have lost") EndIf EndSub End>QGB341.sb< Start>QGF526-0.sb< graphicwindow() player() bunker() Createmissiles() invader() invaderstartpos() invadermove() 'missile shooting loop While shoot = 0 invadermove() start = Clock.ElapsedMilliseconds If (spaceDown) Then FireMissile() spaceDown = "False" EndIf Updatemissiles() delay = 20 - (Clock.ElapsedMilliseconds - start) If (delay > 0) Then Program.Delay(delay) EndIf processKey() ' <----------- Shapes.Move(player,playerX-25,playerY-25) ' <----------- EndWhile 'While key = 0 ' processKey() ' Shapes.Move(player,playerX-25,playerY-25) ' Program.Delay(10) 'EndWhile 'Graphic Window Sub graphicwindow GraphicsWindow.Title = "V-Space Invader" gw = 700 gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp keyLeft = 0 keyRight = 0 key = 0 shoot = 0 GraphicsWindow.BackgroundColor = "black" 'TitleLogo = Shapes.AddImage("http://i61.tinypic.com/14w4r5k.png") 'Shapes.Move(TitleLogo,gw - 468,gh - 400) 'GraphicsWindow.DrawText(10, gh - 20, "Loading...") 'Program.Delay(5000) 'Shapes.Remove(TitleLogo) 'Space GraphicsWindow.DrawImage("http://i58.tinypic.com/t66qeg.png",0,0) EndSub 'Player Sub player player = Shapes.AddImage("http://i62.tinypic.com/2nhkowg.png") playerX = 300 playerY = 500 Lives = 3 Score = 0 speed = 7 HP = 100 'ship starts in the mid bottom of the map Shapes.Move(player,playerX,playerY) For y = 1 To 1 writeText[y] = Shapes.AddText("Lives: "+Lives+" Score: "+Score) Shapes.Move(writeText[y], 30,gh-590) EndFor EndSub 'Bunkers Sub bunker Bunker1 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Bunker2 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Bunker3 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Shapes.Move(Bunker1,100,410) Shapes.Move(Bunker2,300,410) Shapes.Move(Bunker3,500,410) For x = 1 To 3 writeText[x] = Shapes.AddText("HP: " + HP) Shapes.Move(writeText[x], 120 + ((x-1)*200), 415) EndFor EndSub 'Invader Sub invader inv = 1 For i = 1 to 1 invader[i] = Shapes.AddImage("http://i58.tinypic.com/34pe0yb.png") inx[i] = 50 iny[i] = 30 EndFor EndSub Sub invaderstartpos Shapes.AddImage(invader[1]) Shapes.Move(invader[1],inx[1],iny[1]) rl = 1 EndSub Sub invadermove Shapes.Move(invader[1],inx[1],iny[1]) 'While ' <----------- inv = 1 If rl = 1 then inx[1] = inx[1] + 6 EndIf If rl = 0 then inx[1] = inx[1] - 6 EndIf ' Program.Delay(1000) ' <----------- Shapes.Move(invader[1],inx[1],iny[1]) If inx[1] > 540 and iny[1] = 30 then inx[1] = 540 iny[1] = 80 rl = 0 EndIf If inx[1] < 50 and iny[1] = 80 then inx[1] = 50 iny[1] = 130 rl = 1 EndIf If inx[1] > 540 and iny[1] = 130 then inx[1] = 540 iny[1] = 180 rl = 0 EndIf If inx[1] < 50 and iny[1] = 180 then inx[1] = 50 iny[1] = 230 rl = 1 EndIf If inx[1] > 540 and iny[1] = 230 then inx[1] = 540 iny[1] = 280 rl = 0 EndIf If inx[1] > 540 and iny[1] = 280 then inx[1] = 50 iny[1] = 330 rl = 1 EndIf If inx[1] < 50 and iny[1] = 330 then inv = 0 EndIf ' EndWhile ' <----------- EndSub Sub Createmissiles missileImage = ImageList.LoadImage("http://i61.tinypic.com/vxn1xy.png") 'missile dimensions we use the half width and height missileWidth = ImageList.GetWidthOfImage(missileImage)/2 missileHeight = ImageList.GetHeightOfImage(missileImage)/2 nummissile = 5 For i = 1 To nummissile missileData["image"] = Shapes.AddImage(missileImage) missileData["Xpos"] = missileWidth + Math.GetRandomNumber(gw-2*missileWidth) missileData["Ypos"] = gh-missileHeight missileData["Xvel"] = 0 missileData["Yvel"] = -5 missileData["Status"] = 0 Shapes.HideShape(missileData["image"]) missiles[i] = missileData EndFor EndSub Sub Updatemissiles For i = 1 To nummissile missileData = missiles[i] 'get current missile array If (missileData["Status"] = 1) Then 'Reposition missile center missileData["Xpos"] = missileData["Xpos"] + missileData["Xvel"] missileData["Ypos"] = missileData["Ypos"] + missileData["Yvel"] 'Move missile center Shapes.Move(missileData["image"],missileData["Xpos"]-missileWidth,missileData["Ypos"]-missileHeight) 'missile finished with If (missileData["Ypos"] < -missileHeight) Then missileData["Status"] = 0 Shapes.HideShape(missileData["image"]) EndIf missiles[i] = missileData 'save updated missile array (it may have been modified) EndIf EndFor EndSub Sub FireMissile NN=NN+1 ' <----------- increment missile number missileData = missiles[NN] ' <----------- get NN'th missile array If (missileData["Status"] = 0) Then missileData["Status"] = 1 Shapes.ShowShape(missileData["image"]) missileData["Xpos"] = playerX + 30 missileData["Ypos"] = playerY + 10 missiles[NN] = missileData ' <---- save updated missile array (it may have been modified) EndIf If NN=nummissile Then NN=0 ' <----------- to recycle EndIf EndSub Sub OnKeyDown lastkey = GraphicsWindow.LastKey If lastkey = "Space" then shoot = 0 spaceDown = "True" EndIf If (lastKey = "Left") Then keyLeft = 1 ElseIf (lastKey = "Right") Then keyRight = 1 EndIf If lastkey = "Escape" Then Program.End() EndIf EndSub Sub OnKeyUp lastKey = GraphicsWindow.LastKey If (lastKey = "Left") Then keyLeft = 0 ElseIf (lastKey = "Right") Then keyRight = 0 EndIf EndSub Sub processKey If (keyLeft = 1) Then playerX = playerX-speed EndIf If (keyRight = 1) Then playerX = playerX+speed EndIf 'Check for hitting edges If (playerX < 0) Then playerX = 0 EndIf If (playerY < 0) Then playerY = 0 EndIf EndSub End>QGF526-0.sb< Start>QGF526.sb< graphicwindow() player() bunker() Createmissiles() invader() invaderstartpos() invadermove() 'Graphic Window Sub graphicwindow GraphicsWindow.Title = "V-Space Invader" gw = 700 gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp keyLeft = 0 keyRight = 0 key = 0 shoot = 0 GraphicsWindow.BackgroundColor = "black" 'TitleLogo = Shapes.AddImage("http://i61.tinypic.com/14w4r5k.png") 'Shapes.Move(TitleLogo,gw - 468,gh - 400) 'GraphicsWindow.DrawText(10, gh - 20, "Loading...") 'Program.Delay(5000) 'Shapes.Remove(TitleLogo) 'Space GraphicsWindow.DrawImage("http://i58.tinypic.com/t66qeg.png",0,0) EndSub 'Player Sub player player = Shapes.AddImage("http://i62.tinypic.com/2nhkowg.png") playerX = 300 playerY = 500 Lives = 3 Score = 0 speed = 7 HP = 100 'ship starts in the mid bottom of the map Shapes.Move(player,playerX,playerY) For y = 1 To 1 writeText[y] = Shapes.AddText("Lives: "+Lives+" Score: "+Score) Shapes.Move(writeText[y], 30,gh-590) EndFor EndSub 'Bunkers Sub bunker Bunker1 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Bunker2 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Bunker3 = Shapes.AddImage("http://i58.tinypic.com/egz90o.png") Shapes.Move(Bunker1,100,410) Shapes.Move(Bunker2,300,410) Shapes.Move(Bunker3,500,410) For x = 1 To 3 writeText[x] = Shapes.AddText("HP: " + HP) Shapes.Move(writeText[x], 120 + ((x-1)*200), 415) EndFor EndSub 'Invader Sub invader inv = 1 For i = 1 to 1 invader[i] = Shapes.AddImage("http://i58.tinypic.com/34pe0yb.png") inx[i] = 50 iny[i] = 30 EndFor EndSub Sub invaderstartpos Shapes.AddImage(invader[1]) Shapes.Move(invader[1],inx[1],iny[1]) rl = 1 EndSub Sub invadermove Shapes.Move(invader[1],inx[1],iny[1]) While inv = 1 If rl = 1 then inx[1] = inx[1] + 6 EndIf If rl = 0 then inx[1] = inx[1] - 6 EndIf Program.Delay(1000) Shapes.Move(invader[1],inx[1],iny[1]) If inx[1] > 540 and iny[1] = 30 then inx[1] = 540 iny[1] = 80 rl = 0 EndIf If inx[1] < 50 and iny[1] = 80 then inx[1] = 50 iny[1] = 130 rl = 1 EndIf If inx[1] > 540 and iny[1] = 130 then inx[1] = 540 iny[1] = 180 rl = 0 EndIf If inx[1] < 50 and iny[1] = 180 then inx[1] = 50 iny[1] = 230 rl = 1 EndIf If inx[1] > 540 and iny[1] = 230 then inx[1] = 540 iny[1] = 280 rl = 0 EndIf If inx[1] > 540 and iny[1] = 280 then inx[1] = 50 iny[1] = 330 rl = 1 EndIf If inx[1] < 50 and iny[1] = 330 then inv = 0 EndIf EndWhile EndSub 'missile shooting loop While shoot = 0 start = Clock.ElapsedMilliseconds If (spaceDown) Then FireMissile() spaceDown = "False" EndIf Updatemissiles() delay = 20 - (Clock.ElapsedMilliseconds - start) If (delay > 0) Then Program.Delay(delay) EndIf EndWhile Sub Createmissiles missileImage = ImageList.LoadImage("http://i61.tinypic.com/vxn1xy.png") 'missile dimensions we use the half width and height missileWidth = ImageList.GetWidthOfImage(missileImage)/2 missileHeight = ImageList.GetHeightOfImage(missileImage)/2 nummissile = 5 For i = 1 To nummissile missileData["image"] = Shapes.AddImage(missileImage) missileData["Xpos"] = missileWidth + Math.GetRandomNumber(gw-2*missileWidth) missileData["Ypos"] = gh-missileHeight missileData["Xvel"] = 0 missileData["Yvel"] = -5 missileData["Status"] = 0 Shapes.HideShape(missileData["image"]) missiles[i] = missileData EndFor EndSub Sub Updatemissiles For i = 1 To nummissile missileData = missiles[i] 'get current missile array If (missileData["Status"] = 1) Then 'Reposition missile center missileData["Xpos"] = missileData["Xpos"] + missileData["Xvel"] missileData["Ypos"] = missileData["Ypos"] + missileData["Yvel"] 'Move missile center Shapes.Move(missileData["image"],missileData["Xpos"]-missileWidth,missileData["Ypos"]-missileHeight) 'missile finished with If (missileData["Ypos"] < -missileHeight) Then missileData["Status"] = 0 Shapes.HideShape(missileData["image"]) EndIf missiles[i] = missileData 'save updated missile array (it may have been modified) EndIf EndFor EndSub Sub FireMissile NN=NN+1 ' <----------- increment missile number missileData = missiles[NN] ' <----------- get NN'th missile array If (missileData["Status"] = 0) Then missileData["Status"] = 1 Shapes.ShowShape(missileData["image"]) missileData["Xpos"] = playerX + 30 missileData["Ypos"] = playerY + 10 missiles[NN] = missileData ' <---- save updated missile array (it may have been modified) EndIf If NN=nummissile Then NN=0 ' <----------- to recycle EndIf EndSub While key = 0 processKey() Shapes.Move(player,playerX-25,playerY-25) Program.Delay(10) EndWhile Sub OnKeyDown lastkey = GraphicsWindow.LastKey If lastkey = "Space" then shoot = 0 spaceDown = "True" EndIf If (lastKey = "Left") Then keyLeft = 1 ElseIf (lastKey = "Right") Then keyRight = 1 EndIf If lastkey = "Escape" Then Program.End() EndIf EndSub Sub OnKeyUp lastKey = GraphicsWindow.LastKey If (lastKey = "Left") Then keyLeft = 0 ElseIf (lastKey = "Right") Then keyRight = 0 EndIf EndSub Sub processKey If (keyLeft = 1) Then playerX = playerX-speed EndIf If (keyRight = 1) Then playerX = playerX+speed EndIf 'Check for hitting edges If (playerX < 0) Then playerX = 0 EndIf If (playerY < 0) Then playerY = 0 EndIf EndSub End>QGF526.sb< Start>QGK077-0.sb< ' Line with Character in TextWindow ' Copyright © 2015-2017 Nonki Takahashi. The MIT License. ' Last update 2017-03-13 ' Program ID QGK077-0 param = "char=A;col1=0;row1=0;col2=79;row2=24;color=Cyan;" TW_DrawLineWithChar() param = "char=B;col1=0;row1=24;col2=79;row2=0;color=Yellow;" TW_DrawLineWithChar() param = "char=C;col1=0;row1=12;col2=79;row2=12;color=Green;" TW_DrawLineWithChar() param = "char=D;col1=40;row1=0;col2=40;row2=24;color=Red;" TW_DrawLineWithChar() TextWindow.CursorLeft = 0 TextWindow.CursorTop = 0 TextWindow.ForegroundColor = "Gray" Sub TW_DrawLineWithChar ' TextWindow | Draw line with character ' param["char"] - character ' param["col1"] - column of the first cell ' param["row1"] - row of the first cell ' param["col2"] - column of the second cell ' param["row2"] - row of the second cell ' param["color"] - color of the character TextWindow.ForegroundColor = param["color"] width = Math.Abs(param["col2"] - param["col1"]) height = Math.Abs(param["row2"] - param["row1"]) If width < height Then flipColRow = "True" xchg = param["col1"] param["col1"] = param["row1"] param["row1"] = xchg xchg = param["col2"] param["col2"] = param["row2"] param["row2"] = xchg Else flipColRow = "False" EndIf If param["row1"] <= param["row2"] Then startRow = param["row1"] endRow = param["row2"] Else startRow = param["row2"] endRow = param["row1"] EndIf If param["col1"] <= param["col2"] Then dirCol = 1 Else dirCol = -1 EndIf row1c = param["row1"] + 0.5 row2c = param["row2"] + 0.5 For col = param["col1"] To param["col2"] Step dirCol If row1c = row2c Then row = row1c Else row = Math.Floor(row1c + col / width * (row2c - row1c)) EndIf If flipColRow Then TextWindow.CursorLeft = row TextWindow.CursorTop = col Else TextWindow.CursorLeft = col TextWindow.CursorTop = row EndIF TextWindow.Write(param["char"]) EndFor EndSub End>QGK077-0.sb< Start>QGL367.sb< TextWindow.Left = 1 TextWindow.Top = 1 For i = 1 To 255 If i < 10 Then Ausgabe = " " ElseIf i > 9 and i < 100 Then Ausgabe = " " ElseIf i > 99 and i < 1000 Then Ausgabe = " " Else Ausgabe = "" EndIf Ausgabe = text.Append(Ausgabe, i) Ausgabe = text.Append(Ausgabe, "= ") Ausgabe = text.Append(Ausgabe, Text.GetCharacter(i)) Ausgabe = text.Append(Ausgabe, "/") TextWindow.Write(Ausgabe) EndFor End>QGL367.sb< Start>QGM604-1.sb< ' Challenge of the month August 2013 Duck Shooting Game by NaochanON QGM604-0 ' Interface Challenge Write a fancy Game Opening screen for DuckShoot game CRB694-1 ' Throw Boomerang FHX732-0 LRShapes_Init() LRShapes_Add() ' add duck's shapes Back_Shapes_Init() Back_Shapes_Add() ' add grass's shapes BMRShapes_Init() BMRShapes_Add() ' add boomerang's shapes OpeningAnime() ' opening animation GraphicsWindow.MouseDown=Onmousedown GraphicsWindow.MouseMove=Onmousemove GraphicsWindow.MouseUp=onmouseup falling="False" While ThrowBNMB<11 Shapes.SetText(msg, " Now you threw "+(ThrowBNMB-1)+" boomerangs. You hit "+HitCount+" ducks !!!!!") NN=NN+1 DuckFlying() Grass_Swing() If Throw="True" Then Fly_boomerang() ' boomerang is throwed hitcheck() endif Program.Delay(20) endwhile Ending() Sub hitcheck FlyBMR_XY ="X="+ Shapes.GetLeft(BMRshp[ThrowBNMB][1]["obj"])+";Y="+Shapes.GetTop(BMRshp[ThrowBNMB][1]["obj"]) ' Flying boomerang position FlyDuck_XY="X="+ Shapes.GetLeft(shp[LR[LRNMB]][M][1]["obj"]) +";Y="+ Shapes.Gettop(shp[LR[LRNMB]][M][1]["obj"]) ' Flying Duck position HeadWidth=shp[LR[LRNMB]][M][1]["width"]*s1 ' Duck's head size If -30-100 Then k=k+dk ' rotating angle dZM=(1-K/ZM) ' zoom ratio dx=dx+dd["X"] ' sliding rate X dy=dy+dd["Y"] ' sliding rate Y RK= Math.GetRadians(-k) ' unclockwise BMRX[j] '------------------------------------------------------------------------------ Shapes.Zoom(BMRshp[ThrowBNMB][1]["obj"],dZM,dZM) ' boomerang size becomes smaller gradually Shapes.Move(BMRshp[ThrowBNMB][1]["obj"],BMRX[ThrowBNMB]+dZM*DR[1]*Math.Sin(-RK)-dZM*DW[1]+dx,BMRY[ThrowBNMB]+dZM*DR[1]*Math.cos(-RK)-dZM*DR[1]-dy) Shapes.Rotate(BMRshp[ThrowBNMB][1]["obj"],-k) '------------------------------------------------------------------------------ RK2= Math.GetRadians(-(k-90)) Shapes.Zoom(BMRshp[ThrowBNMB][2]["obj"],dZM,dZM) Shapes.Move(BMRshp[ThrowBNMB][2]["obj"],BMRX[ThrowBNMB]+dZM*DR[2]*Math.Sin(-RK2)-dZM*DW[2]+dx,BMRY[ThrowBNMB]+dZM*DR[2]*Math.cos(-RK2)-dZM*DR[2]-dy) Shapes.Rotate(BMRshp[ThrowBNMB][2]["obj"],-(k-90)) Else FlyBMR_NMB() endif EndSub Sub FlyBMR_NMB Throw="False" ThrowBNMB=ThrowBNMB+1 ' next boomerang Shapes.SetOpacity(BMRshp[ThrowBNMB][1]["obj"],100) ' next boomerang appears Shapes.SetOpacity(BMRshp[ThrowBNMB][2]["obj"],100) EndSub Sub DuckFlying M=FlyNMB if Shapes.Gettop(shp[LR[LRNMB]][M][1]["obj"])>-100 Then delay=0 FLYDY[M]= 5-Math.GetRandomNumber(10) ' Flapping rate Shapes.Zoom(shp[LR[LRNMB]][M][4]["obj"],1,0.7-FlyDY[M]/7) ' duck Flapping Shapes.Zoom(shp[LR[LRNMB]][M][6]["obj"],1,0.7-FlyDY[M]/7) For i=1 to 9 shapes.Move(shp[LR[LRNMB]][M][i]["obj"],Shapes.GetLeft(shp[LR[LRNMB]][M][i]["obj"])+DuckDX[M],Shapes.Gettop(shp[LR[LRNMB]][M][i]["obj"]) -DuckDY[M]) EndFor Else delay=delay+1 EndIf If delay>= 30 Then ' Next Duck appears if delay>=30 FlyNMB=FlyNMB+1 delay=0 flyNMB_speed() EndIf EndSub Sub flyNMB_speed LRNMB= Math.Remainder(FlyNMB,2)+1 ' Duck flying direction .... 1:Right or 2:Left DuckDX[FlyNMB]=(Math.GetRandomNumber(10)-Math.Remainder(FlyNMB,2)*20)/3 ' flying speed X DuckDY[FlyNMB]=(16-Math.GetRandomNumber(6))/4 ' flying speed XY endsub Sub Ending Shapes.SetText(msg, " You hit "+HitCount+" ducks !!!!!") Shapes.Zoom(msg,3,3) Shapes.Animate(msg,700,550,3000) Sound.PlayChime() EndSub Sub Onmouseup If catch<>"False" Then Mx2= GraphicsWindow.MouseX My2= GraphicsWindow.MouseY BMRX[ThrowBNMB]=Mx2 ' released point X BMRY[ThrowBNMB]=MY2 ' released point Y MX1=MX2 MY1=MY2 EndIf catch="false" dd="X="+(Mx1-MX)/10 +";Y="+ (MY-My1)/10 ' sliding rate Throw="True" k=0 ' angle dx=0 ' sliding X dY=0 ' sliding Y dk=20 ' rotating rate ZM=3500 ' zoom rate DR="1="+(BMRshp[ThrowBNMB][1]["height"]*s3/2)+";2="+(BMRshp[ThrowBNMB][2]["height"]*s3/2) ' radius length DW="1="+(BMRshp[ThrowBNMB][1]["width"]*s3/2)+";2="+(BMRshp[ThrowBNMB][2]["width"]*s3/2) ' width/2 EndSub Sub Onmousemove If catch="true" Then Mx1= GraphicsWindow.MouseX My1= GraphicsWindow.MouseY Shapes.Move(BMRshp[ThrowBNMB][1]["obj"],Mx1,My1) ' moved by mouse Shapes.Move(BMRshp[ThrowBNMB][2]["obj"],Mx1-45*s3,My1-45*s3) Distance_r=Math.SquareRoot((Mx1-BMRX[ThrowBNMB])*(Mx1-BMRX[ThrowBNMB])+ (My1-BMRY[ThrowBNMB])*(My1-BMRY[ThrowBNMB])) If Distance_r>150 Then ' Distance_r=distance from initial position BMRX[ThrowBNMB]=Mx1 ' released point X BMRY[ThrowBNMB]=MY1 ' released point Y catch="False" onmouseup() ' forced throwing endif EndIf EndSub Sub Onmousedown Mx= GraphicsWindow.MouseX My= GraphicsWindow.MouseY If math.Abs(MX-BMRX[ThrowBNMB])<10 And math.Abs(MY-BMRY[ThrowBNMB])<30 Then ' if boomerang is caught catch="true" EndIf EndSub Sub OpeningAnime While LX>-1000 NN=NN+1 Grass_Swing() For j=1 To 10 DuckDX[j]=5+Math.GetRandomNumber(5) ' Flapping rate DuckDY[j]= 5-Math.GetRandomNumber(10) Shapes.Zoom(shp["L"][j][4]["obj"],1,0.7-DuckDY[j]/7) ' duck flaps Shapes.Zoom(shp["L"][j][6]["obj"],1,0.7-DuckDY[j]/7) Shapes.Zoom(shp["R"][j][4]["obj"],1,0.7-DuckDY[j]/7) Shapes.Zoom(shp["R"][j][6]["obj"],1,0.7-DuckDY[j]/7) For i=1 to 9 shapes.Move(shp["L"][j][i]["obj"],Shapes.GetLeft(shp["L"][j][i]["obj"])-DuckDX[j],Shapes.Gettop(shp["L"][j][i]["obj"]) +DuckDY[j]) shapes.Move(shp["R"][j][i]["obj"],Shapes.GetLeft(shp["R"][j][i]["obj"])+DuckDX[j],Shapes.Gettop(shp["R"][j][i]["obj"]) +DuckDY[j]) EndFor endfor Program.Delay(20) LX=Shapes.GetLeft( shp["L"][1][1]["obj"]) ' 1st Duck's position X Shapes.Move(msg,LX,shapes.GetTop(msg)) EndWhile Shapes.Move(msg,100,shapes.GetTop(msg)) Shapes.SetText(msg," Now start Duck shooting !!!!!!!!!!!!!!") InitPosition() Program.Delay(1500) '----------------------------------------------------------------------------------------------------------- ThrowBNMB=1 ' 1st boomerang Shapes.SetOpacity(BMRshp[ThrowBNMB][1]["obj"],100) ' 1st boomerang appears Shapes.SetOpacity(BMRshp[ThrowBNMB][2]["obj"],100) '--------------------------------------------------------------------------------------------------------- FlyNMB=1 ' starting Duck Number flyNMB_speed() '--------------------------------------------------------------------------------------------------------- HitCount=0 ' hit count endsub Sub InitPosition For j=1 To 10 Duckdy=50-Math.GetRandomNumber(50) For i=1 to 9 Shapes.Move(shp["L"][j][i]["obj"], 700 + shp["L"][j][i]["x"]*s1+(j-1)*15, 400 + shp["L"][j][i]["y"]*s1+Duckdy) Shapes.Move(shp["R"][j][i]["obj"], 200 + shp["R"][j][i]["x"]*s1+(j-1)*15, 400 + shp["R"][j][i]["y"]*s1+Duckdy) EndFor EndFor endsub Sub Grass_Swing If Math.Remainder(NN,8)=0 Then Gda=5-Math.GetRandomNumber(8) For j=1 To GN For i=1 To 16 Step 2 Shapes.Rotate(Bshp[j][i]["obj"], Gda) Shapes.Rotate(Bshp[j][i+1]["obj"], -1.2*Gda) EndFor EndFor endif EndSub Sub BMRShapes_Init BNMB=10 ' Boomerang number CLR="1=#B1300E;2=#B13FFE;3=#316745;4=#DCCB18;5=#8D6449;6=#494A41;7=#D4ACAD;8=#82AE46;9=#00A497;10=#165E83" ' Color of boomerang For j=1 To BNMB CLR[j]=GraphicsWindow.GetRandomColor() BMRshp[j][1] = "func=ell;x=0;y=0;width=20;height=60;angle=0;bc="+CLR[j]+";pc="+CLR[j]+";pw=2;" BMRshp[j][2] = "func=ell;x=-45;y=-45;width=20;height=90;angle=-90;bc="+CLR[j]+";pc="+CLR[j]+";pw=2;" EndFor EndSub Sub BMRShapes_Add BX0 = 450 BY0 = 650 For j=BNMB To 1 Step -1 s3=0.6 ' S3 dx=dx+j*3 dy=0 For i = 1 To 2 GraphicsWindow.PenWidth = BMRshp[j][i]["pw"]*s3 GraphicsWindow.PenColor = BMRshp[j][i]["pc"] GraphicsWindow.BrushColor = BMRshp[j][i]["bc"] If BMRshp[j][i]["func"] = "ell" Then BMRshp[j][i]["obj"] = shapes.AddEllipse(BMRshp[j][i]["width"]*s3, BMRshp[j][i]["height"]*s3) EndIf Shapes.Move(BMRshp[j][i]["obj"], BX0 + BMRshp[j][i]["x"]*s3+dX, BY0 + BMRshp[j][i]["y"]*s3+dy) If BMRshp[j][i]["angle"] <> 0 Then Shapes.Rotate(BMRshp[j][i]["obj"], BMRshp[j][i]["angle"]) EndIf EndFor Shapes.SetOpacity(BMRshp[j][1]["obj"],0) ' boomerang disappears Shapes.SetOpacity(BMRshp[j][2]["obj"],0) BMRX[j]= Shapes.GetLeft(BMRshp[j][1]["obj"])+BMRshp[j][1]["width"]*s3/2 ' cross point X BMRY[j]= Shapes.Gettop(BMRshp[j][1]["obj"]) ' cross point Y endfor dx=0 EndSub Sub LRShapes_Init For j=1 To 10 Shp["R"][j][1] = "func=ell;x=99;y=0;width=56;height=24;bc=#DFCA54;pc=#000000;pw=2;" ' Head Shp["R"][j][2] = "func=ell;x=129;y=6;width=15;height=6;bc=#DF3954;pc=#000000;pw=2;" ' Eye Shp["R"][j][3] = "func=ell;x=105;y=12;width=16;height=36;angle=45;bc=#00CA54;pc=#000000;pw=2;" ' Neck Shp["R"][j][4] = "func=tri;x=50;y=5;x1=21;y1=0;x2=0;y2=57;x3=29;y3=57;bc=#DFCA54;pc=#000000;pw=2;" 'Wing Shp["R"][j][5] = "func=ell;x=1;y=38;width=108;height=31;bc=#DFCA54;pc=#000000;pw=2;" ' Body Shp["R"][j][6] = "func=tri;x=37;y=0;x1=7;y1=0;x2=0;y2=57;x3=29;y3=57;bc=#DF8754;pc=#000000;pw=2;" 'Wing Shp["R"][j][7] = "func=ell;x=144;y=15;width=29;height=9;angle=13;bc=#DF8754;pc=#000000;pw=2;" 'Mouth Shp["R"][j][8] = "func=line;x=8;y=60;x1=0;y1=8;x2=49;y2=7;pc=#DF3954;pw=2;" Shp["R"][j][9] = "func=line;x=0;y=70;x1=9;y1=0;x2=0;y2=10;pc=#DF3954;pw=2;" Shp["L"][j][1] = "func=ell;x=29;y=17;width=61;height=38;bc=#DFCA54;pc=#000000;pw=2;" ' Head Shp["L"][j][2] = "func=ell;x=46;y=23;width=18;height=9;angle=354;bc=#DF3954;pc=#000000;pw=2;" ' Eye Shp["L"][j][3] = "func=ell;x=70;y=45;width=16;height=36;angle=313;bc=#00CA54;pc=#000000;pw=2;" ' Neck Shp["L"][j][4] = "func=tri;x=104;y=4;x1=10;y1=0;x2=0;y2=64;x3=45;y3=64;angle=0;bc=#DFCA54;pc=#000000;pw=2;" ' Wing Shp["L"][j][5] = "func=ell;x=80;y=58;width=146;height=44;bc=#DFCA54;pc=#000000;pw=2;" ' Body Shp["L"][j][6] = "func=tri;x=144;y=0;x1=40;y1=0;x2=0;y2=75;x3=46;y3=75;angle=0;bc=#DF8754;pc=#000000;pw=2;" ' Wing Shp["L"][j][7] = "func=ell;x=0;y=34;width=39;height=14;angle=354;bc=#DFCA54;pc=#000000;pw=2;" ' Beak Shp["L"][j][8] = "func=line;x=157;y=95;x1=0;y1=0;x2=58;y2=4;pc=#DF3954;pw=4;" ' Leg Shp["L"][j][9] = "func=line;x=213;y=99;x1=0;y1=0;x2=14;y2=9;pc=#DF3954;pw=4;" ' Leg EndFor EndSub Sub Back_Shapes_Init GN=7 X0 =-20 Y0 = 140 For j=1 To GN Bshp[j][1] = "func=tri;x=6;y=20;x1=6;y1=0;x2=0;y2=93;x3=13;y3=93;angle=1;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][2] = "func=rect;x=6;y=110;width=14;height=76;angle=4;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][3] = "func=tri;x=30;y=7;x1=6;y1=0;x2=0;y2=93;x3=13;y3=93;angle=1;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][4] = "func=rect;x=30;y=98;width=14;height=76;angle=1;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][5] = "func=tri;x=50;y=21;x1=5;y1=0;x2=0;y2=80;x3=11;y3=80;angle=359;bc=#AD9E00;pc=#AD9E00;pw=2;" Bshp[j][6] = "func=rect;x=49;y=97;width=13;height=78;angle=2;bc=#AD9E00;pc=#AD9E00;pw=2;" Bshp[j][7] = "func=tri;x=79;y=39;x1=5;y1=0;x2=0;y2=71;x3=10;y3=71;angle=358;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][8] = "func=rect;x=77;y=108;width=14;height=70;angle=2;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][9] = "func=tri;x=96;y=14;x1=6;y1=0;x2=0;y2=93;x3=13;y3=93;angle=6;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][10] = "func=rect;x=96;y=105;width=14;height=76;angle=3;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][11] = "func=tri;x=106;y=37;x1=6;y1=0;x2=0;y2=66;x3=13;y3=66;angle=1;bc=#759E00;pc=#759E00;pw=2;" Bshp[j][12] = "func=rect;x=106;y=104;width=14;height=70;angle=2;bc=#759E00;pc=#759E00;pw=2;" '759 Bshp[j][13] = "func=tri;x=123;y=45;x1=5;y1=0;x2=0;y2=71;x3=10;y3=71;angle=358;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][14] = "func=rect;x=122;y=111;width=13;height=67;angle=2;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][15] = "func=tri;x=174;y=54;x1=6;y1=0;x2=0;y2=57;x3=13;y3=57;angle=1;bc=#009E00;pc=#009E00;pw=2;" Bshp[j][16] = "func=rect;x=172;y=110;width=14;height=76;angle=3;bc=#009E00;pc=#009E00;pw=2;" endfor Bshp[1][17] ="func=rect;x=0;y=155;width=1200;height=600;bc=#DF8722;pc=#AD9E00;pw=2;" ' land EndSub Sub LRShapes_Add GraphicsWindow.Hide() GraphicsWindow.Title=" Duck shooting game ... Using boomerang !!!! " GraphicsWindow.BackgroundColor="Lightcyan" GraphicsWindow.Left=20 GraphicsWindow.top=20 GraphicsWindow.Width=1200 GraphicsWindow.Height=700 '------------------------------------------------------------------------------------------ XY0["X"] ="1=-2000;2=1500" XY0["Y"] ="1=300;2=300" LR="1=R;2=L" For k=1 To 2 For j=1 To 10 Duckdy=50-Math.GetRandomNumber(100) s1=(3 + (30-Math.GetRandomNumber(20))/10 )/10 ' S1 For i = 1 To 9 GraphicsWindow.PenWidth = shp[LR[k]][j][i]["pw"]*s1 GraphicsWindow.PenColor = shp[LR[k]][j][i]["pc"] GraphicsWindow.BrushColor = shp[LR[k]][j][i]["bc"] If shp[LR[k]][j][i]["func"] = "ell" Then shp[LR[k]][j][i]["obj"] = shapes.AddEllipse(shp[LR[k]][j][i]["width"]*s1, shp[LR[k]][j][i]["height"]*s1) ElseIf shp[LR[k]][j][i]["func"] = "tri" Then shp[LR[k]][j][i]["obj"] = shapes.AddTriangle(shp[LR[k]][j][i]["x1"]*s1, shp[LR[k]][j][i]["y1"]*s1, shp[LR[k]][j][i]["x2"]*s1, shp[LR[k]][j][i]["y2"]*s1, shp[LR[k]][j][i]["x3"]*s1, shp[LR[k]][j][i]["y3"]*s1 ) ElseIf shp[LR[k]][j][i]["func"] = "line" Then shp[LR[k]][j][i]["obj"] = shapes.AddLine(shp[LR[k]][j][i]["x1"]*s1, shp[LR[k]][j][i]["y1"]*s1, shp[LR[k]][j][i]["x2"]*s1, shp[LR[k]][j][i]["y2"]*s1) EndIf Shapes.Move(shp[LR[k]][j][i]["obj"], Xy0["X"][k] + shp[LR[k]][j][i]["x"]*s1+(j-1)*150, XY0["Y"][K] + shp[LR[k]][j][i]["y"]*s1+Duckdy) If shp[LR[k]][j][i]["angle"] <> 0 Then Shapes.Rotate(shp[LR[k]][j][i]["obj"], shp[LR[k]][j][i]["angle"]) EndIf EndFor endfor endfor '------------------------------------------------------------------------------------------ LX=Shapes.GetLeft( shp["L"][1][1]["obj"]) RX=Shapes.GetLeft( shp["R"][1][1]["obj"]) EndSub Sub Back_Shapes_Add '------------------------------------------------------------------------------------------ For j=1 To GN s2=1.1+Math.GetRandomNumber(3)/10 ' S2 For i = 17 To 1 Step -1 GraphicsWindow.PenWidth = Bshp[j][i]["pw"]*s2 GraphicsWindow.PenColor = Bshp[j][i]["pc"] GraphicsWindow.BrushColor = Bshp[j][i]["bc"] If Bshp[j][i]["func"] = "rect" Then Bshp[j][i]["obj"] = shapes.AddRectangle(Bshp[j][i]["width"]*s2, Bshp[j][i]["height"]*s2) ElseIf Bshp[j][i]["func"] = "tri" Then Bshp[j][i]["obj"] = shapes.AddTriangle(Bshp[j][i]["x1"]*s2, Bshp[j][i]["y1"]*s2, Bshp[j][i]["x2"]*s2, Bshp[j][i]["y2"]*s2, Bshp[j][i]["x3"]*s2, Bshp[j][i]["y3"]*s2 ) endif Shapes.Move(Bshp[j][i]["obj"], X0 + Bshp[j][i]["x"]*s2+(j-1)*170, Y0 + Bshp[j][i]["y"]*s2) If Bshp[j][i]["angle"] <> 0 Then Shapes.Rotate(Bshp[j][i]["obj"], Bshp[j][i]["angle"]) EndIf EndFor endfor '------------------------------------------------------------------------------------------ GraphicsWindow.BrushColor="White" Circle= Shapes.AddEllipse(600,600) Shapes.Move(Circle,300,450) '------------------------------------------------------------------------------------------ GraphicsWindow.BrushColor="Red" GraphicsWindow.FontSize=20 CRLF= Text.GetCharacter(13)+Text.GetCharacter(10) msg="Duck Shooting Game ........ You can throw 10 boomerangs to get Ducks ! "+CRLF+"Click the boomerang and release it in the white circle."+CRLF+"If boomerang hits duck's head, you can get a duck" msg= Shapes.AddText(msg) Shapes.Move(msg,1200,50) GraphicsWindow.Show() EndSub End>QGM604-1.sb< Start>QGP302.sb< GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp Screen_Width = 800 Screen_Height = 600 Object_Radius = 100 Object_Corners = 10 Object_VY = 0 Object_Angle = 0 Limit = 0.3 Gravity = 0.5 Friction = 0.98 AirResistance = 0.98 Object_Rotation = Math.GetRandomNumber(20)-10 Ground = Screen_Height-50 Pi = Math.Pi Object_Frozen = "False" GraphicsWindow.Width = Screen_Width GraphicsWindow.Height = Screen_Height Shapes.AddLine(0, Ground, Screen_Width, Ground) GraphicsWindow.PenWidth = 0.3 Shapes.AddLine(Screen_Width/2, 0, Screen_Width/2, Screen_Height) Shapes.AddLine(0, Screen_Height/2, Screen_Width, Screen_Height/2) TextWindow.Left = GraphicsWindow.Left + Screen_Width + 15 TextWindow.Top = GraphicsWindow.Top GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "LightBlue" Line = Shapes.AddLine(0, Screen_Height, 0, 0) Object_Initialize() Object_X = Screen_Width/2 Object_Y = Screen_Height/2 Object_Arrange_Corners() Draw_Text() GraphicsWindow.PenColor = "Green" 'Main loop: While GraphicsWindow.LastKey <> "Escape" Time_Start = Clock.ElapsedMilliseconds Object_VY = Object_VY + Gravity Object_Y = Object_Y + Object_VY Object_Rotation = Object_Rotation * AirResistance Object_Angle = Object_Angle + Object_Rotation Controls() Object_Update() Object_Draw() If(Mouse.IsLeftButtonDown)Then Object_X = GraphicsWindow.MouseX Object_Y = GraphicsWindow.MouseY Object_VY = 0 Object_Arrange_Corners() EndIf If(Object_Frozen = "True")Then TextWindow.WriteLine("Object_Frozen = True!") EndIf If(Math.Abs(Object_Rotation) >= Limit)Then Object_Frozen = "False" EndIf Time_Passed = Clock.ElapsedMilliseconds - Time_Start PerfectDelay = 15 - Time_Passed If PerfectDelay > 0 Then Program.Delay(PerfectDelay) EndIf EndWhile Program.End() 'This ends the program when escape is pressed Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = "Left") Then Left = "True" ElseIf (Key = "Right") Then Right = "True" endif EndSub Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = "Left") Then Left = "False" ElseIf (Key = "Right") Then Right = "False" endif EndSub Sub Controls If(Left = "True")Then Object_Rotation = Object_Rotation - 0.5 ElseIf(Right = "True")Then Object_Rotation = Object_Rotation + 0.5 EndIf EndSub Sub Object_Arrange_Corners For i = 1 To Object_Corners Corner_X[i] = Object_X + Math.Cos(Object_Angle + Corner_Angle[i]) * Corner_Radius[i] Corner_Y[i] = Object_Y + Math.Sin(Object_Angle + Corner_Angle[i]) * Corner_Radius[i] EndFor EndSub Sub Object_Initialize GraphicsWindow.BrushColor = "Red" GraphicsWindow.PenWidth = 0 For i = 1 To Object_Corners Corner[i] = Shapes.AddEllipse(5,5) Corner_Angle[i] = i*(360/Object_Corners) Corner_Radius[i] = Math.GetRandomNumber(Object_Radius-Object_Radius/3) + Object_Radius/3 EndFor Corner[Object_Corners+1] = Shapes.AddEllipse(10, 10) GraphicsWindow.PenWidth = 1 Xsum = 0 Ysum = 0 'Randomly add Corners in the right angle: For i = 1 To Object_Corners Corner_X[i] = Object_Radius/2 + Math.Cos(Math.GetRadians(Corner_Angle[i])) * Corner_Radius[i] Corner_Y[i] = Object_Radius/2 + Math.Sin(Math.GetRadians(Corner_Angle[i])) * Corner_Radius[i] Xsum = Xsum + Corner_X[i] Ysum = Ysum + Corner_Y[i] EndFor 'Get the Centroid of the Corners: Object_X = Xsum/Object_Corners Object_Y = Ysum/Object_Corners 'Recalculate the radius for each Corner to keep the Objects X and Y as the centroid: For i = 1 To Object_Corners 'Is it possiblle that i made a mistake somewhere?! Xdist = Object_X - Corner_X[i] Ydist = Object_Y - Corner_Y[i] Corner_Radius[i] = Math.SquareRoot(Xdist*Xdist + Ydist*Ydist) EndFor EndSub Sub Object_Update Object_Checkwalls() 'Rotate Object corners For i = 1 To Object_Corners theta = Math.GetRadians(Object_Angle + Corner_Angle[i]) Corner_X[i] = Object_X + Math.Cos(theta) * Corner_Radius[i] Corner_Y[i] = Object_Y + Math.Sin(theta) * Corner_Radius[i] Shapes.Move(Corner[i],Corner_X[i]-2.5,Corner_Y[i]-2.5) endfor 'UPDATE Object Shapes.Move(Corner[Object_Corners+1], Object_X-5, Object_Y-5) EndSub Sub Object_Draw Lasti = Object_Corners For i = 1 To Object_Corners Shapes.Remove(Corner_Line[i]) Corner_Line[i] = Shapes.AddLine(Corner_X[i], Corner_Y[i], Corner_X[Lasti], Corner_Y[Lasti]) Lasti = i EndFor EndSub Sub Object_Checkwalls iLow_Old = iLow 'Find lowest corner - we only want one on the ground at any point in time iLow = 1 For i = 2 To Object_Corners If(Corner_Y[i] > Corner_Y[iLow])Then iLow = i EndIf EndFor 'Check this corner for on the ground and find block centre - due to small rounding errors with the trig we need to to check for 'near' If (Corner_Y[iLow] > Ground Or Math.Abs(Corner_Y[iLow]-Ground) < 1) Then 'if under ground or distance to it <1 then: Corner_Y[iLow] = Ground Object_VY = 0 theta = Math.GetRadians(Object_Angle+Corner_Angle[iLow] + 180) Object_X = Corner_X[iLow] + Math.Cos(theta) * Corner_Radius[iLow] Object_Y = Corner_Y[iLow] + Math.Sin(theta) * Corner_Radius[iLow] If(Object_Frozen = "False")Then If(iLow_Old = iLow)Then 'If just ONE corner is touching the ground: Object_Rotation = Object_Rotation * Friction Object_Rotation = Object_Rotation + (Object_X - Corner_X[iLow])*0.002 ElseIf(iLow_Old <> iLow)Then 'If TWO Corners are touching the ground (this doesn't really happen, but it's almost the same): Object_Rotation = Object_Rotation * Friction/2 TextWindow.WriteLine("TWO CORNERS Touching the Ground!") If(Math.Abs(Object_Rotation) < Limit)Then TextWindow.WriteLine("Object_Rotation < "+Limit+"!") Object_Rotation = 0 Object_Frozen = "True" EndIf EndIf EndIf Shapes.Move(Line, Corner_X[iLow], 0) EndIf EndSub Sub Draw_Text GraphicsWindow.BrushColor = "DeepSkyBlue" GraphicsWindow.DrawText(20, 20, "- Use the mouse to drag and drop the Object") GraphicsWindow.DrawText(20, 40, "- Use the arrow keys to rotate the Object") GraphicsWindow.DrawText(20, 60, "- The blue line marks the Corner that is touching the Ground") EndSub End>QGP302.sb< Start>QGP868.sb< 'Written by Thaemann-Pioniere -Initializing The Program GraphicsWindow.Title="Lemaitre Question" GraphicsWindow.Height=500 GraphicsWindow.Width=750 GraphicsWindow.CanResize="False" GraphicsWindow.BackgroundColor="LightBlue" GraphicsWindow.BrushColor="Brown" GraphicsWindow.PenWidth=10 Turtle.Speed=10 'START MAIN PROGRAM SetupArray() SetupGraphicsWindow() Controls.ButtonClicked= ButtonDown 'execute the subroutine Buttondown when a Button is hit 'End Main Program sub SetUpArray Field[1]="Box=Rectangle;BH=0;BV=16;BHS=29;BVS=495;color=Brown" Field[2]="Box=Rectangle;BH=0;BV=484;BHS=760;BVS=30;color=Brown" Field[3]="Box=Texte;Texte=LadderLength : ;TH=380;TV=45;color=Blue" Field[4]="Box=Input;BH=490;BV=40;BHS=660;BVS=40;color=Blue;Action=500" Field[5]="Box=Exec;Texte=Done;BH=660;BV=37;BHS=490;BVS=40" EndSub sub SetupGraphicsWindow For C1=3 to 5 If Field[C1]["Box"]="Rectangle" Then GraphicsWindow.BrushColor=Field[C1]["color"] GraphicsWindow.FillRectangle(Field[C1]["BH"], Field[C1]["BV"],Field[C1]["BHS"], Field[C1]["BVS"]) elseif Field[C1]["Box"]="Texte" Then GraphicsWindow.brushColor=Field[C1]["color"] GraphicsWindow.DrawText(Field[C1]["TH"], Field[C1]["TV"],Field[C1]["Texte"]) elseif Field[C1]["Box"]="Input" Then GraphicsWindow.brushColor=Field[C1]["red"] Btn[C1]=Controls.AddTextBox(Field[C1]["BH"],Field[C1]["BV"]) Controls.SetSize(Btn["C1"],Field[C1]["BHS"], Field[C1]["BVS"]) Controls.SetTextBoxText(Btn[C1],Field[C1]["Action"]) elseif Field[C1]["Box"]="Exec" Then Btn[C1]=Controls.AddButton(Field[C1]["Texte"],Field[C1]["BH"],Field[C1]["BV"]) Controls.SetSize(Btn["C1"],Field[C1]["BHS"], Field[C1]["BVS"]) endif endfor endsub SUB ButtonDown 'Subroutine that is waiting Btn is hit Cap=Controls.GetButtonCaption(Controls.LastClickedButton) TextWindow.WriteLine("cap ="+cap+"=") TextWindow.WriteLine("B4 ="+Btn[4]+"=") if cap="Done" then Ladderlength=Controls.GetTextBoxText(Btn[4]) Calculations() endif endsub SUB Calculations TextWindow.WriteLine("Ladderlength = "+ Ladderlength) TextWindow.WriteLine("Start calculations") endsub End>QGP868.sb< Start>QGR352.sb< 'SmallBasic Paint V1.0 'Created By The Hacker2 'Please use any code you would like''I will add a tutorial version eventually just to help people alond'' I will also make it without Fremy's extension, for a challenge and for people who don't have it' GraphicsWindow.Width = Desktop.Width/2+200 GraphicsWindow.Title = "SmallBasic Paint V1.0 Created By The Hacker2" GraphicsWindow.Height = 44*10 GraphicsWindow.CanResize = "False" GraphicsWindow.Left = 1 GraphicsWindow.Top =1 GraphicsWindow.MouseMove = OnMouseMove PenSize = 2 Color[1] = "LightCoral" Color[2] = "Salmon" Color[3] ="DarkSalmon" Color[4] ="LightSalmon" Color[5] ="Crimson" Color[6] ="Red" Color[7] ="FireBrick" Color[8] ="DarkRed" Color[9] ="Pink" Color[10] ="LightPink" Color[11] ="HotPink" Color[12] ="DeepPink" Color[13] ="MediumVioletRed" Color[14] ="PaleVioletRed" Color[15] ="LightSalmon" Color[16] ="Coral" Color[17] ="Tomato" Color[18] ="OrangeRed" Color[19] ="DarkOrange" Color[20] ="Orange" Color[21] ="Gold" Color[22] ="Yellow" Color[23] ="LightYellow" Color[24] ="LemonChiffon" Color[25] ="LightGoldenrodYellow" Color[26] ="PapayaWhip" Color[27] ="Moccasin" Color[28] ="PeachPuff" Color[29] ="PaleGoldenrod" Color[30] ="Khaki" Color[31] ="DarkKhaki" Color[32] ="Lavender" Color[33] ="Thistle" Color[34] ="Plum" Color[35] ="Violet" Color[36] ="Orchid" Color[37] ="Fuchsia" Color[38] ="Magenta" Color[39] ="MediumOrchid" Color[40] ="MediumPurple" Color[41] ="BlueViolet" Color[42] ="DarkViolet" Color[43] ="DarkOrchid" Color[44] ="DarkMagenta" Color[45] ="Purple" Color[46] ="Indigo" Color[47] ="SlateBlue" Color[48] ="DarkSlateBlue" Color[49] ="MediumSlateBlue" Color[50] ="MediumSpringGreen" Color[51] ="MediumSeaGreen" Color[52] ="SpringGreen" Color[53] ="SeaGreen" Color[54] ="forestGreen" Color[55] ="Green" Color[56] ="DarkGreen" Color[57] ="Yellowgreen" Color[58] ="OliveDrab" Color[59] ="Olive" Color[60] ="DarkOliveGreen" Color[61] ="MediumAquamarine" Color[62] ="DarkSeaGreen" Color[63] ="LightSeaGreen" Color[64] ="DarkCyan" Color[65] ="Teal" Color[66] ="Aqua" Color[67] ="Cyan" Color[68] ="LightCyan" Color[69] ="PaleTurquoise" Color[70] ="Aquamarine" Color[71] ="Turquoise" Color[72] ="MediumTurquoise" Color[73] ="DarkTurquoise" Color[74] ="CadetBlue" Color[75] ="SteelBlue" Color[76] ="LightSteelBlue" Color[77] ="PowderBlue" Color[78] ="LightBlue" Color[79] ="SkyBlue" Color[80] ="GreenYellow" Color[81] ="Chartreuse" Color[82] ="LawnGreen" Color[83] ="Lime" Color[84] ="LimeGreen" Color[85] ="PaleGreen" Color[86] ="LightGreen" Color[87] = "White" For j = 0 to 43 GraphicsWindow.BrushColor = Color[j+1] GraphicsWindow.DrawRectangle(0,j*10,10,10) GraphicsWindow.FillRectangle(0,j*10,10,10) ColorBox[j+1] = Color[j+1] EndFor For i = 0 To 43 GraphicsWindow.BrushColor = Color[i*2+1] GraphicsWindow.DrawRectangle(10,i*10,10,10) GraphicsWindow.FillRectangle(10,i*10,10,10) ColorBox[i*2+1] = Color[i*2+1] EndFor GraphicsWindow.BrushColor = "Gray" GraphicsWindow.DrawRectangle(20,0,200,44*10) GraphicsWindow.FillRectangle(20,0,200,44*10) PUB = Controls.AddButton(75,25, "Pen Up") Controls.Move(PUB, 27.5,7) Controls.RegisterMouseDownEvent(PUB,"PenSizeUp") PDB = Controls.AddButton(75,25, "Pen Down") Controls.Move(PDB,110,7) Controls.RegisterMouseDownEvent(PDB, "PenSizeDown") EB = Controls.AddButton(75,25,"Eraser") Controls.Move(EB,27.5,39) Controls.RegisterMouseDownEvent(EB,"Eraser") BB = Controls.AddButton(75,25,"Brush") Controls.Move(BB,110,39) Controls.RegisterMouseDownEvent(BB, "Brush") BCB = Controls.AddButton(75,25, "Background") Controls.Move(BCB,27.5,72) Controls.RegisterMouseDownEvent(BCB,"BackgroundColor") SB = Controls.AddButton(75,25,"Square") Controls.Move(SB,110,72) Controls.RegisterMouseDownEvent(SB,"DrawSquare") NB = Controls.AddButton(75,25,"Clear") Controls.Move(NB,27.5,107) Controls.RegisterMouseDownEvent(NB, "Clear") GraphicsWindow.MouseDown = OnMouseDown Sub Clear endsub Sub OnMouseDown prevX = GraphicsWindow.MouseX prevY = GraphicsWindow.MouseY If(prevx < 20 And prevy < 44*10)Then Graphicswindow.PenColor = GraphicsWindow.GetPixel(x,y) endif EndSub Sub OnMouseMove x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY If (Mouse.IsLeftButtonDown) Then If x > 220 And y < 44*10 Then GraphicsWindow.DrawLine(prevX, prevY,X , Y) Endif EndIf prevX = x prevY = y EndSub Sub Paint endsub Sub DrawSquare Endsub Sub BackgroundColor Dialogs.T_PromptDialogTitle = "Bakcground Color" GraphicsWindow.BackgroundColor = Dialogs.AskForTextLine("New Background Color") Endsub Sub Brush GraphicsWindow.PenColor = "Black" EndSub Sub Eraser GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor Endsub Sub PenSizeDown PenSize = PenSize-2 GraphicsWindow.PenWidth = PenSize Endsub Sub PenSizeUp PenSize = PenSize + 2 GraphicsWindow.PenWidth = PenSize EndSub End>QGR352.sb< Start>QGT518.sb< GraphicsWindow.Title="Iovi Sub main GraphicsWindow.BackgroundColor = "#000022" Init() px = 60 py = 8 ii=ImageList.LoadImage("e:/jupi.jpg") GraphicsWindow.DrawImage(ii, -px, -py) w = 400 - 2 * px h = 283 - 2 * py ra = 64 x = w / 2 For z = ra * 2 To 0 Step -1 y = h * z / (ra * 2) c[z] = GraphicsWindow.GetPixel(x, y) EndFor GraphicsWindow.Clear() DrawStars() ' sphere param["x"] = ra param["y"] = ra For z = ra * 2 To 0 Step -1 param["color"] = c[z] param["z"] = z ha = Math.Abs(ra - z) rb = Math.SquareRoot(ra * ra - ha * ha) param["r"] = rb If ra < z Then z2 = z + 1 Else z2 = z - 1 EndIf ha2 = Math.Abs(ra - z2) rb2 = Math.SquareRoot(ra * ra - ha2 * ha2) param["w"] = Math.Max(Math.Abs(rb - rb2), 2) GraphicsWindow.BrushColor=c[z] DrawRingOnXY() EndFor For i = 1 To j LDShapes.AnimateOpacity(stt[i] 3500+Math.GetRandomNumber(50)*150 0) EndFor EndSub Sub Init UNDEFINED = "N/A" gw = 600 gh = 500 cx = gw/2 cy = gh/2-30 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = 0.5 * gw yo = 0.46 * gh u = 2 ru = u * Math.SquareRoot(2 / 3) a60 = Math.GetRadians(60) a120 = Math.GetRadians(120) ColorsqqInit() EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf ColorqqNameToRGB() colorRight = color ColorqqRGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 0.1, 1) ColorqqHSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.2, 0) ColorqqHSLtoRGB() colorLeft = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub DrawRingOnXY ' param["x"], param["y"] - center of the ring ' param["z"] - X-Y surface ' param["r"] - radius of the ring ' param["w"] - width of the ring Stack.PushValue("local", param) ox = param["x"] oy = param["y"] rb = param["r"] wr = param["w"] For y = oy + rb To oy - rb Step -1 param["y"] = y hb = Math.Abs(y - oy) w = Math.SquareRoot(rb * rb - hb * hb) If rb - wr < hb Then For x = ox + w To ox - w Step -1 param["x"] = x DrawVoxel() EndFor Else w2 = Math.SquareRoot((rb - wr) * (rb - wr) - hb * hb) For x = ox + w To ox + w2 Step -1 param["x"] = x DrawVoxel() EndFor For x = ox - w2 To ox - w Step -1 param["x"] = x DrawVoxel() EndFor EndIf EndFor param = Stack.PopValue("local") EndSub Sub DrawStars GraphicsWindow.PenWidth=0 For i = 1 To 1000 l = Math.GetRandomNumber(255) x = Math.GetRandomNumber(gw) y = Math.GetRandomNumber(gh) d = Math.GetRandomNumber(u) GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(l, l, l) rr=LDMath.Convert2Radial(cx cy x y) If rr[1]>135 Then j=j+1 stt[j]=Shapes.AddEllipse(d d) Shapes.Move(stt[j] x, y) EndIf EndFor EndSub Sub DrawVoxel CalcColors() x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillEllipse(x1, y1, 4,4) EndSub Sub ColorqqHSLtoRGB If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 ColorqqValue() r = value h = hue ColorqqValue() g = value h = hue - 120 ColorqqValue() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub ColorqqNameToRGB If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub ColorqqValue If h >= 360 Then h = h - 360 EndIf If h < 0 Then h = h + 360 EndIf If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub ColorqqRGBtoHSL ColorqqNameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR MathqqHex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG MathqqHex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB MathqqHex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub ColorqqGrayFromLightness iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub ColorsqqInit colors["black"]="#000000" colors["white"]="#FFFFFF" EndSub Sub MathqqHex2Dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub main() End>QGT518.sb< Start>QGV368-0.sb< GraphicsWindow.BackgroundColor="teal GraphicsWindow.Title = "Small Basic Logo" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh While "True" DrawLogo() Program.Delay(1500) GraphicsWindow.Clear() EndWhile Sub DrawLogo GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "Black" mask = Shapes.AddRectangle(gw , gh) Shapes.SetOpacity(mask, 0) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillEllipse(120, 150, 100, 100) param = "x=120;y=150;size=50;color=Orange AddSquare() param = "x=170;y=200;size=50;color=Red AddSquare() param = "x=170;y=150;size=50;color=Lime AddSquare() param = "x=120;y=200;size=50;color=Blue AddSquare() GraphicsWindow.BrushColor = "White" n = 8 ' octagon x1 = 170 ' center y1 = 200 r = 32 ' circumradius x2 = x1 ' top vertex y2 = y1 - r RegularPolygon() GraphicsWindow.BrushColor = "DimGray" r = 28 ' circumradius y2 = y1 - r RegularPolygon() Program.Delay(500) GraphicsWindow.BrushColor = "White" r = 21 ' circumradius y2 = y1 - r RegularPolygon() GraphicsWindow.PenColor = "DimGray" GraphicsWindow.PenWidth = 6 GraphicsWindow.DrawLine(x1 - 24, y1, x1 + 24, y1) GraphicsWindow.PenWidth = 16 GraphicsWindow.DrawLine(x1, y1 - 24, x1, y1 + 24) Program.Delay(500) GraphicsWindow.PenColor = "White" GraphicsWindow.PenWidth = 4 GraphicsWindow.DrawLine(x1 - 15, y1 - 5, x1, y1 - 5) GraphicsWindow.DrawLine(x1 - 28, y1 + 5, x1 - 15, y1 + 5) GraphicsWindow.DrawLine(x1, y1 - 50, x1, y1 + 50) GraphicsWindow.DrawLine(x1 - 50, y1, x1 - 30, y1) GraphicsWindow.DrawLine(x1 + 30, y1, x1 + 50, y1) r2 = 30 r3 = 52 r4 = 440 For a = 0 To 315 Step 45 _a = Math.GetRadians(a) x2 = x1 + r2 * Math.Sin(_a) y2 = y1 + r2 * Math.Cos(_a) x3 = x1 + r3 * Math.Sin(_a) y3 = y1 + r3 * Math.Cos(_a) x4 = x1 + r4 * Math.Sin(_a) y4 = y1 + r4 * Math.Cos(_a) If Math.Remainder(a, 90) <> 0 Then GraphicsWindow.DrawLine(x2, y2, x3, y3) EndIf light[a] = Shapes.AddLine(x1, y1, x4, y4) EndFor GraphicsWindow.FontBold = "False" GraphicsWindow.BrushColor = "darkblue GraphicsWindow.FontName = "Segoe UI Semibold" GraphicsWindow.FontSize = 21 GraphicsWindow.DrawText(230, 160, "Microsoft") GraphicsWindow.FontName = "Segoe UI GraphicsWindow.FontSize = 20 GraphicsWindow.FontItalic="true GraphicsWindow.BrushColor = "white GraphicsWindow.DrawText(230, 230, "Every Kid Can Code") GraphicsWindow.FontItalic="false GraphicsWindow.FontName = "Segoe Print" GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "darkblue GraphicsWindow.DrawText(232, 172, "Small Basic") GraphicsWindow.BrushColor = "#F4501F" GraphicsWindow.DrawText(230, 170, "Small Basic") GraphicsWindow.PenWidth = 3 GraphicsWindow.PenColor = "#FCB901" args=0 For op = 80 To 0 Step -1 Shapes.SetOpacity(mask, op) Program.Delay(10) EndFor For op = 100 To 0 Step -1 For a = 0 To 315 Step 45 Shapes.SetOpacity(light[a], op) EndFor Program.Delay(5) EndFor LDCall.Function5 ("tline" 230, 227, 460-230, 90 500) LDCall.Function5 ("tline" 0 0, 30, 180 500) LDCall.Function5 ("tline" 0 0, 460-230+6, 270 500) Turtle.Turn(-45) For x=1 To 263 If x>74 Then Turtle.PenUp () Turtle.Speed=10 EndIf Turtle.Turn (3.8) Turtle.Move (5.25) EndFor Turtle.Speed=8 Turtle.Angle=90 Turtle.PenDown() Turtle.Move(120) For r=1 To 3 Turtle.TurnRight () Turtle.Move(10) Turtle.TurnLeft () Turtle.Move(10) EndFor Turtle.Move(90) Turtle.Hide () EndSub Sub tline LDShapes.ResetTurtle () Turtle.Angle=args[4] Turtle.PenUp () Turtle.speed=9 If args[1]+args[2]<>0 then Turtle.x=args[1] Turtle.Y=args[2] endif Turtle.PenDown() Turtle.Move (args[3]) Program.Delay (args[5]) EndSub Sub AddSquare width = param["size"] x = param["x"] y = param["y"] addColor = param["color"] GraphicsWindow.PenWidth =2 GraphicsWindow.PenColor ="teal GraphicsWindow.DrawRectangle (x y width width ) LDGraphicsWindow.FloodFill (x+width/2 y+ width/2 addColor ) EndSub Sub GetLine ' param x, y - left end position of the line ' param width - of the line ' return seg - segment array for the line seg = "" iSeg = 0 For _x = x To x + width - 1 color = GraphicsWindow.GetPixel(_x, y) If seg[iSeg]["color"] <> color Then iSeg = iSeg + 1 seg[iSeg]["color"] = color seg[iSeg]["x"] = _x seg[iSeg]["y"] = y seg[iSeg]["width"] = 1 Else seg[iSeg]["width"] = seg[iSeg]["width"] + 1 EndIf EndFor EndSub Sub AddLine ' param seg - segment array for a line ' param subColor - color to subtract nSeg = Array.GetItemCount(seg) index = Array.GetAllIndices(seg) color2 = addColor For iSeg = 1 To nSeg color1 = seg[iSeg]["color"] GraphicsWindow.BrushColor = color2 GraphicsWindow.FillRectangle(seg[iSeg]["x"], seg[iSeg]["y"], seg[iSeg]["width"], 1) EndFor EndSub Sub RegularPolygon ' GraphicsWindow.PenWidth=0 'pp=LDShapes.AddRegularPolygon (n r) ' ldShapes.centre (pp x1 y1) For i = 1 To n a = 2 * Math.Pi * i / n x3 = x1 + r * Math.Sin(a) y3 = y1 - r * Math.Cos(a) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) ' fill 'GraphicsWindow.DrawLine(x2, y2, x3, y3) ' draw x2 = x3 y2 = y3 EndFor EndSub End>QGV368-0.sb< Start>QGV368.sb< ' Small Basic Logo ' Logo Copyright © 2016 Microsoft. ' Program Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID GraphicsWindow.Title = "Small Basic Logo" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh While "True" DrawLogo() Program.Delay(5000) GraphicsWindow.Clear() EndWhile Sub DrawLogo GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "Black" mask = Shapes.AddRectangle(gw , gh) Shapes.SetOpacity(mask, 0) GraphicsWindow.BrushColor = "White" GraphicsWindow.FillRectangle(0, 0, gw, gh) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillEllipse(120, 150, 100, 100) param = "x=120;y=150;size=50;color=#F4501F;" ' Orange AddSquare() param = "x=170;y=200;size=50;color=#FCB901;" ' Yellow AddSquare() param = "x=170;y=150;size=50;color=#7CB70A;" ' Green AddSquare() param = "x=120;y=200;size=50;color=#03A3ED;" ' Blue AddSquare() GraphicsWindow.BrushColor = "White" n = 8 ' octagon x1 = 170 ' center y1 = 200 r = 32 ' circumradius x2 = x1 ' top vertex y2 = y1 - r RegularPolygon() GraphicsWindow.BrushColor = "DimGray" r = 28 ' circumradius y2 = y1 - r RegularPolygon() Program.Delay(500) GraphicsWindow.BrushColor = "White" r = 21 ' circumradius y2 = y1 - r RegularPolygon() GraphicsWindow.PenColor = "DimGray" GraphicsWindow.PenWidth = 6 GraphicsWindow.DrawLine(x1 - 24, y1, x1 + 24, y1) GraphicsWindow.PenWidth = 16 GraphicsWindow.DrawLine(x1, y1 - 24, x1, y1 + 24) Program.Delay(500) GraphicsWindow.PenColor = "White" GraphicsWindow.PenWidth = 4 GraphicsWindow.DrawLine(x1 - 15, y1 - 5, x1, y1 - 5) GraphicsWindow.DrawLine(x1 - 28, y1 + 5, x1 - 15, y1 + 5) GraphicsWindow.DrawLine(x1, y1 - 50, x1, y1 + 50) GraphicsWindow.DrawLine(x1 - 50, y1, x1 - 30, y1) GraphicsWindow.DrawLine(x1 + 30, y1, x1 + 50, y1) r2 = 30 r3 = 52 r4 = 440 For a = 0 To 315 Step 45 _a = Math.GetRadians(a) x2 = x1 + r2 * Math.Sin(_a) y2 = y1 + r2 * Math.Cos(_a) x3 = x1 + r3 * Math.Sin(_a) y3 = y1 + r3 * Math.Cos(_a) x4 = x1 + r4 * Math.Sin(_a) y4 = y1 + r4 * Math.Cos(_a) If Math.Remainder(a, 90) <> 0 Then GraphicsWindow.DrawLine(x2, y2, x3, y3) EndIf light[a] = Shapes.AddLine(x1, y1, x4, y4) EndFor GraphicsWindow.FontBold = "False" GraphicsWindow.BrushColor = "DimGray" GraphicsWindow.FontName = "Segoe UI Semibold" GraphicsWindow.FontSize = 21 GraphicsWindow.DrawText(230, 160, "Microsoft") GraphicsWindow.FontSize = 10 GraphicsWindow.BrushColor = "Gray" GraphicsWindow.DrawText(230, 230, "Every Kid Can Code") GraphicsWindow.BrushColor = "#F4501F" GraphicsWindow.FontName = "Segoe Print" GraphicsWindow.FontSize = 40 GraphicsWindow.DrawText(230, 170, "Small Basic") GraphicsWindow.PenWidth = 3 GraphicsWindow.PenColor = "#FCB901" GraphicsWindow.DrawLine(230, 227, 460, 227) For op = 80 To 0 Step -1 Shapes.SetOpacity(mask, op) Program.Delay(10) EndFor For op = 100 To 0 Step -1 For a = 0 To 315 Step 45 Shapes.SetOpacity(light[a], op) EndFor Program.Delay(5) EndFor EndSub Sub AddSquare width = param["size"] x = param["x"] addColor = param["color"] For y = param["y"] To param["y"] + width - 1 GetLine() AddLine() EndFor EndSub Sub GetLine ' param x, y - left end position of the line ' param width - of the line ' return seg - segment array for the line seg = "" iSeg = 0 For _x = x To x + width - 1 color = GraphicsWindow.GetPixel(_x, y) If seg[iSeg]["color"] <> color Then iSeg = iSeg + 1 seg[iSeg]["color"] = color seg[iSeg]["x"] = _x seg[iSeg]["y"] = y seg[iSeg]["width"] = 1 Else seg[iSeg]["width"] = seg[iSeg]["width"] + 1 EndIf EndFor EndSub Sub AddLine ' param seg - segment array for a line ' param subColor - color to subtract nSeg = Array.GetItemCount(seg) index = Array.GetAllIndices(seg) color2 = addColor For iSeg = 1 To nSeg color1 = seg[iSeg]["color"] Color_Add() GraphicsWindow.BrushColor = color GraphicsWindow.FillRectangle(seg[iSeg]["x"], seg[iSeg]["y"], seg[iSeg]["width"], 1) EndFor EndSub Sub RegularPolygon For i = 1 To n a = 2 * Math.Pi * i / n x3 = x1 + r * Math.Sin(a) y3 = y1 - r * Math.Cos(a) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) ' fill 'GraphicsWindow.DrawLine(x2, y2, x3, y3) ' draw x2 = x3 y2 = y3 EndFor EndSub Sub Color_Add ' param color1, color2 - for color addition ' return color - result color = color1 Color_RGBToValues() rgb1 = rgb color = color2 Color_RGBToValues() rgb2 = rgb For i = 1 To 3 rgb[i] = Math.Min(rgb1[i] + rgb2[i], 255) EndFor color = GraphicsWindow.GetColorFromRGB(rgb[1], rgb[2], rgb[3]) EndSub Sub Color_RGBToValues ' param color - "#rrggbb" ' return rgb[] - 0..255 for each red, green, and blue hex = Text.GetSubText(color, 2, 2) Math_Hex2Dec() rgb[1] = dec hex = Text.GetSubText(color, 4, 2) Math_Hex2Dec() rgb[2] = dec hex = Text.GetSubText(color, 6, 2) Math_Hex2Dec() rgb[3] = dec EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex - hexadecimal ' return dec - decimal dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QGV368.sb< Start>QGW926.sb< DrawForm() Controls.ButtonClicked = OnButtonClicked Sub OnButtonClicked dividend = Math.Abs(Math.Floor(Math.Max(Controls.GetTextBoxText(txtBox[1]), Controls.GetTextBoxText(txtBox[2])))) divisor = Math.Abs(Math.Floor(Math.Min(Controls.GetTextBoxText(txtBox[1]), Controls.GetTextBoxText(txtBox[2])))) If dividend * divisor <> 0 Then GetGFC() Else Shapes.SetText(writeResult, Math.Max(dividend, divisor)) EndIf EndSub Sub GetGFC If Math.Remainder(dividend, divisor) > 0 Then j = divisor divisor = Math.Remainder(dividend, divisor) dividend = j GetGFC() Else Shapes.SetText(writeResult, divisor) EndIf EndSub Sub DrawForm txtBox[1] = Controls.AddTextBox(10, 10) txtBox[2] = Controls.AddTextBox(10, 40) GraphicsWindow.DrawText(180, 12, "1st number") GraphicsWindow.DrawText(180, 12+30, "2nd number") btn = Controls.AddButton("=", 10, 70) writeResult = Shapes.AddText("GCF") Shapes.Move(writeResult, 40, 74) GraphicsWindow.FontSize = GraphicsWindow.FontSize * 0.8 GraphicsWindow.DrawText(10, 100, "decimals truncate to integers") EndSub End>QGW926.sb< Start>QGX228.sb< fistTwoPrimes = "1=2;2=3" i = 2 n = 3 start = Clock.ElapsedMilliseconds While (Clock.ElapsedMilliseconds - start) <= 60000 'loops upto 60s n = n + 2 isPrime = "True" For j = 2 To Math.SquareRoot(n) If (Math.Remainder(n, j) = 0) Then isPrime = "False" EndIf EndFor If isPrime Then i = i + 1 prime = n EndIf EndWhile TextWindow.Write(i + ": ") TextWindow.Write(prime + " ") End>QGX228.sb< Start>QGX714.sb< ' setting the graphicswindow GraphicsWindow.Width = 600 GraphicsWindow.Height = 600 GraphicsWindow.BackgroundColor = "snow GraphicsWindow.BrushColor = "white GraphicsWindow.penColor = "darkslategray GraphicsWindow.penwidth = "6 GraphicsWindow.MouseDown=pngsave ' Drawing The Background Grid GraphicsWindow.DrawLine(50, 120, 50, 550)' 1 GraphicsWindow.DrawLine(550, 50, 550, 550)'1 GraphicsWindow.DrawLine(50, 50, 550, 50)' 2 GraphicsWindow.DrawLine(120, 50, 120, 120)'3 GraphicsWindow.DrawLine(350, 50, 350, 250)'3 GraphicsWindow.DrawLine(120, 250, 120, 550)'4 GraphicsWindow.DrawLine(180, 200, 180, 480)'4 GraphicsWindow.DrawLine(50, 200, 280, 200)'5 GraphicsWindow.DrawLine(200, 120, 350, 120)'6 GraphicsWindow.DrawLine(240, 250, 350, 250)'6 GraphicsWindow.DrawLine(177, 330, 350, 330)'7 GraphicsWindow.DrawLine(240, 420, 420, 420)'7 GraphicsWindow.DrawLine(180, 480, 300, 480)'8 GraphicsWindow.DrawLine(300, 420, 300, 482)'8 GraphicsWindow.DrawLine(420, 120, 420, 420)'9 GraphicsWindow.DrawLine(480, 120, 480, 200)'9 GraphicsWindow.DrawLine(420, 122, 480, 122)'10 GraphicsWindow.DrawLine(420, 250, 480, 250)'10 GraphicsWindow.DrawLine(500, 420, 550, 420)'11 GraphicsWindow.DrawLine(500, 418, 500, 480)'11 GraphicsWindow.DrawLine(380, 480, 500, 480)'11 GraphicsWindow.DrawLine(380, 479, 380, 550)'11 GraphicsWindow.DrawLine(120, 550, 550, 550)'12 ' Sprites sprite_init() shape=sprite Name="sprite" add_sprite() sprite_init() shape=sprite Name="sprite" ' Add shapes // Ball-Graphical Sub add_sprite For M=1 To Array.GetItemCount(scale) ss=scale[M] SName=Name+"_"+M for i=1 To Array.GetItemCount(shape) GraphicsWindow.PenWidth = shape[i]["pw"] GraphicsWindow.BrushColor = shape[i]["bc"] GraphicsWindow.penColor = shape[i]["pc"] If shape[i]["func"]="ell" Then shp[SName][i] = Shapes.AddEllipse(shape[i]["width"]*ss, shape[i]["height"]*ss) ElseIf shape[i]["func"]="rect" Then shp[SName][i] = Shapes.AddRectangle(shape[i]["width"]*ss, shape[i]["height"]*ss) ElseIf shape[i]["func"]="tri" Then shp[SName][i] = Shapes.Addtriangle(shape[i]["x1"]*ss, shape[i]["y1"]*ss,shape[i]["x2"]*ss, shape[i]["y2"]*ss, shape[i]["x3"]*ss, shape[i]["y3"]*ss) ElseIf shape[i]["func"]="line" Then shp[SName][i] = Shapes.Addline(shape[i]["x1"]*ss, shape[i]["y1"]*ss,shape[i]["x2"]*ss, shape[i]["y2"]*ss) ElseIf shape[i]["func"]="txt" Then GraphicsWindow.FontSize=shape[i]["Size"] shp[SName][i] = Shapes.Addtext(shape[i]["Letter"]) EndIf Shapes.Animate(shp[SName][i], shape[i]["x"]*ss+shX[M], shape[i]["y"]*ss+shY[M], 500) Shapes.Rotate(shp[SName][i], Shape[i]["angle"]) EndFor EndFor endsub Sub pngsave MX= GraphicsWindow.MouseX MY= GraphicsWindow.MouseY GraphicsWindow.BackgroundColor=GraphicsWindow.GetRandomColor() ' "rosybrown" endsub sub sprite_Init 'Ball-Graphical scale = "1=0.5;2=.5;3=.5" '4=.5;5=.5" '<---- scale shX ="1=115;2=160;3=430"'4=40;5=420" shY ="1=60;2=370;3=175" '4=420;5=420" sprite[1] = "func=ell;x=50;y=50;width=100;height=100;bc=black;pc=black;pw=2"' B sprite[2] = "func=ell;x=85;y=50;width=30;height=100;angle=120;bc=red;pc=black;pw=1"' R4 sprite[3] = "func=ell;x=85;y=50;width=30;height=100;angle=50;bc=red;pc=black;pw=1"' R3 sprite[4] = "func=ell;x=85;y=50;width=30;height=100;angle=180;bc=red;pc=black;pw=1"' R2 endsub GraphicsWindow.BrushColor = "blue GraphicsWindow.FontSize = 44 cloud = Shapes.Addtext("👹") ' Add a rectangle GraphicsWindow.Title = title + " - Addtext()" GraphicsWindow.BrushColor = "green shp["👹"] = Shapes.Addtext("👹") '(width, height) Shapes.Move(shp["text"], 0, 0) Program.Delay(500) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 1 x = x + 0 y = y + 60 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 2 x = x + 60 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 3 x = x + 0 y = y + 80 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 4 x = x + 230 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 5 x = x + 0 y = y + 57 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 6 x = x + -100 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 7 x = x + 0 y = y + 70 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 8 x = x + 170 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 9 x = x + 0 y = y + 80 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 10 x = x + -181 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 11 x = x + 180 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Shapes.rotate(shp["👹"], 90) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 12 x = x + 0 y = y + -300 Shapes.Animate(shp["👹"], x, y, duration) Shapes.rotate(shp["👹"], 0) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 12 x = x + 140 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 13 x = x + 0 y = y + 300 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 14 x = x + -50 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 15 x = x + 0 y = y + 80 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 16 x = x + -120 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 17 x = x + 0 y = y + 70 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 18 x = x + -200 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 19 x = x + 0 y = y + -300 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 20 x = x + -50 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 21 x = x + 0 y = y + 350 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 22 x = x + -80 y = y + 0 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) ' Animate (move) the Sprite GraphicsWindow.Title = title + " - Animate()" duration = 3000 ' 23 x = x + 0 y = y + -550 Shapes.Animate(shp["👹"], x, y, duration) Program.Delay(3000) Sub Init gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh title = "Sample for Shapes Object" GraphicsWindow.Title = title GraphicsWindow.PenWidth = 4 GraphicsWindow.PenColor = "Black" GraphicsWindow.FontSize = 30 GraphicsWindow.FontName = "Trebuchet MS" EndSub End>QGX714.sb< Start>QHB979.sb< GraphicsWindow.Height = 1000 GraphicsWindow.Width = 1000 GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.PenColor = "White" AFK = Controls.AddButton("Custon Color", 10, 10) GraphicsWindow.BrushColor = "Red" Red = Controls.AddButton("Red", 150 ,10) GraphicsWindow.BrushColor = "Orange" Orange = Controls.AddButton("Orange", 200 ,10) GraphicsWindow.BrushColor = "yellow" Yellow = Controls.AddButton("Yellow", 300 ,10) GraphicsWindow.BrushColor = "green" Green = Controls.AddButton("Green", 400 ,10) GraphicsWindow.BrushColor = "Blue" Blue = Controls.AddButton("Blue", 500 ,10) GraphicsWindow.BrushColor = "Magenta" Magenta = Controls.AddButton("Magenta", 600 ,10) GraphicsWindow.BrushColor = "White" White = Controls.AddButton("White", 700 ,10) GraphicsWindow.BrushColor = "Teal" Teal = Controls.AddButton("Teal", 800 ,10) GraphicsWindow.BrushColor = "Cyan" Cyan = Controls.AddButton("Cyan", 900 ,10) GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.MouseMove = OnMouseMove Controls.ButtonClicked = OnButtonClick Sub OnButtonClick If Controls.LastClickedButton = AFK Then Input = Dialogs.AskForColor() GraphicsWindow.PenColor = Input EndIf If Controls.LastClickedButton = Red Then GraphicsWindow.PenColor = "Red" EndIf If Controls.LastClickedButton = Orange Then GraphicsWindow.PenColor = "Orange" EndIf If Controls.LastClickedButton = Yellow Then GraphicsWindow.PenColor = "Yellow" EndIf If Controls.LastClickedButton = Green Then GraphicsWindow.PenColor = "Green" EndIf If Controls.LastClickedButton = Blue Then GraphicsWindow.PenColor = "Blue" EndIf If Controls.LastClickedButton = Magenta Then GraphicsWindow.PenColor = "Magenta" EndIf If Controls.LastClickedButton = Teal Then GraphicsWindow.PenColor = "Teal" EndIf If Controls.LastClickedButton = Cyan Then GraphicsWindow.PenColor = "Cyan" EndIf If Controls.LastClickedButton = White Then GraphicsWindow.PenColor = "White" EndIf EndSub Sub OnMouseDown prevx = GraphicsWindow.MouseX prevy = GraphicsWindow.MouseY EndSub Sub OnMouseMove x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY If (Mouse.IsLeftButtonDown) Then GraphicsWindow.DrawLine(prevx, prevy, x, y) EndIf prevx = x prevy = y EndSub End>QHB979.sb< Start>QHJ102.sb< ' SmallBasic Version 1.0 ' Funktion: Zock77MathGetAngle ' Autor: Zock77 (mod Pappa Lapub) ' Herkunft: http://social.msdn.microsoft.com/Forums/en-US/2749e2bd-4363-4a64-8158-a2f7ca74fffb/post-your-first-sb-program ' ImportURL: http://smallbasic.com/program/?NKP831 ' Extension: Zock77Math, LitDev (SBMath) ' Kommentar: Zock77Math-Sample: TDW726 ' ' Variablen: ' ' -------------------------------------------------------------------------------- 'Zock77Math.GetAngle(X, Tx, Y, Ty) 'Gets the clockwise angle [degrees] between 2 points in GraphicsWindow 'X = The x coordinate of the target point to which point (Tx,Ty) is turned to 'Tx = The x coordinate of the turning point (0 degrees = 12h) 'y = The y coordinate of the target point to which point (Tx,Ty) is turned to 'Ty = The y coordinate of the rotation point (0 degrees = 12h) ' returns ... The angle [degrees], where +/- for clockwise/counterclockwise ' example ... ID: NKP831 args = "" ' for Variant2 (LDCall) 'GetDegrees3() ' for Variant3 (LDInline) pi = 3.14159 ' Math.Pi W = 60 H = 4 Tx = (GraphicsWindow.Width - W)/2 Ty = (GraphicsWindow.Height - H)/2 line = Shapes.AddRectangle(W,H) Shapes.Move(line,Tx,Ty) GraphicsWindow.MouseMove = OnMouseMove '' EVENT Sub OnMouseMove x = GraphicsWindow.MouseX - W/2 y = GraphicsWindow.MouseY - H/2 xy[1] = x - Tx xy[2] = y - Ty '' VariantOrig ID: NKP831, Zock77Math Ext angle = Zock77Math.GetAngle(x,Tx,y,Ty) - 90 '' Variant1, SUB 'GetDegrees1() '' Variant2, LDCall function 'angle = LDCall.Function4("GetDegrees2", x, Tx, y, Ty) - 90 '' Variant3, LDInline 'angle = LDInline.Call("SBMath.ATan2Deg", xy) ' "1=x;2=y;", additionally uncomment GetDegrees3() '' Variant4, SBMath Ext 'angle = SBMath.ATan2Deg(x-Tx,y-Ty) Shapes.Rotate(line,angle) 'GraphicsWindow.Title = angle EndSub '' SUBs ' Variant1 Sub GetDegrees1 If (x > Tx) Then angle = Math.ArcTan((y-Ty) / (x-Tx)) + pi/2 ElseIf (x < Tx) Then angle = Math.ArcTan((y-Ty) / (x-Tx)) - pi/2 ElseIf (x = Tx And y > Ty) Then angle = Math.ArcTan((y-Ty) / (x-Tx)) + pi EndIf angle = Math.GetDegrees(angle) - 90 EndSub ' Variant2 (LDCall) Sub GetDegrees2 If (args[1] > args[2]) Then return = Math.ArcTan((args[3] - args[4]) / (args[1] - args[2])) + pi/2 ElseIf (args[1] < args[2]) Then return = Math.ArcTan((args[3] - args[4]) / (args[1] - args[2])) - pi/2 ElseIf (args[1] = args[2] And args[3] > args[4]) Then return = Math.ArcTan((args[3] - args[4]) / (args[1] - args[2])) + pi EndIf return = Math.GetDegrees(return) EndSub ' Variant3 (LDInline) Sub GetDegrees3 cs = "using System;" cs = cs+ "using Microsoft.SmallBasic.Library;" cs = cs+ "public static class SBMath {" cs = cs+ "public static Primitive ATan2Deg(Primitive x, Primitive y) {" cs = cs+ "return 180 * System.Math.Atan2(y, x) / System.Math.PI; } }" LDInline.IncludeCS(cs,"","") EndSub End>QHJ102.sb< Start>QHL110.sb< x = 1.5 ArcTan() TextWindow.WriteLine(y) x = 0.6 ArcTan() TextWindow.WriteLine(y) Sub ArcTan If x > 1 then x = 1 / x ArcTanInternal() y = Math.Pi / 2 - y Else ArcTanInternal() EndIf EndSub Sub ArcTanInternal y = x - Math.Power(x, 3) / 3 + Math.Power(x, 5) / 5 - Math.Power(x, 7) / 7 EndSub End>QHL110.sb< Start>QHM145.sb< GraphicsWindow.Title = LDCommPort.OpenPort ("COM12" 115200) GraphicsWindow.BackgroundColor ="teal GraphicsWindow.BrushColor ="red GraphicsWindow.Width=900 GraphicsWindow.Height=900 e=Shapes.AddEllipse (10 10) ox=-1 px=450 py=450 f512=520 While "true rr= LDCommPort.RXChar () If rr>31 then tt=text.Append (tt text.GetCharacter (rr)) Else If Text.StartsWith (tt "X") then yy=text.GetSubTextToEnd (tt 3) elseIf Text.StartsWith (tt "Y") then xx=text.GetSubTextToEnd (tt 3) EndIf px=px+(xx-f512)/600 py=py+(yy-f512)/600 ldShapes.Centre (e px py) If ox>-1 then GraphicsWindow.DrawLine (ox oy px py) endif ox=px oy=py tt="" EndIf EndWhile End>QHM145.sb< Start>QHN542.sb< 'WINDOW GraphicsWindow.Hide() GraphicsWindow.Width = 800 GraphicsWindow.Height = 500 GraphicsWindow.Left = (Desktop.Width - 800) / 2 GraphicsWindow.Top = 50 GraphicsWindow.CanResize = "false" GraphicsWindow.Title = "First Person Shooter" GraphicsWindow.BackgroundColor = "dodgerblue" 'TRAFFIC_POLICEMAN game = Controls.AddButton(1, 0, 0) Controls.HideControl(game) count = Controls.AddButton(0, 0, 0) Controls.HideControl(count) 'BOTTOM_MENU GraphicsWindow.PenColor = "navy" GraphicsWindow.BrushColor = "navy" menuback = Shapes.AddRectangle(800, 80) Shapes.Move(menuback, 0, 420) GraphicsWindow.FontSize = 15 GraphicsWindow.FontBold = "false" GraphicsWindow.FontName = "consolas" GraphicsWindow.BrushColor = "black" score = Controls.AddButton("0", 370, 445) Controls.SetSize(score, 60, 30) 'SHOW_WINDOW GraphicsWindow.Show() 'SOUBROUTINES '*'*'*'*'*'*'*'*'*'*'*' 'MOUSE_MOVE GraphicsWindow.MouseMove = mm Sub mm x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY enemyleft = Shapes.GetLeft(enemy) enemytop = Shapes.GetTop(enemy) EndSub 'MOUSE_DOWN GraphicsWindow.MouseDown = md Sub md If x > enemyleft And x < enemyleft + 50 And y > enemytop And y < enemytop + 50 Then Controls.SetButtonCaption(count, 0) Sound.PlayClick() Shapes.HideShape(enemy) getscore = Controls.GetButtonCaption(score) Controls.SetButtonCaption(score, getscore + 1) EndIf getscore = Controls.GetButtonCaption(score) If getscore = 5 Then Timer.Interval = 1800 Else If getscore = 10 Then Timer.Interval = 1600 Else If getscore = 15 Then Timer.Interval = 1400 Else If getscore = 20 Then Timer.Interval = 1200 Else If getscore = 25 Then Timer.Interval = 1000 Else If getscore = 30 Then Timer.Interval = 800 EndIf EndIf EndIf EndIf EndIf EndIf EndSub 'TIMER-ENEMY Timer.Interval = 2000 Timer.Tick = tick Sub tick getcount = Controls.GetButtonCaption(count) getgame = Controls.GetButtonCaption(game) rx = Math.GetRandomNumber(750) ry = Math.GetRandomNumber(370) GraphicsWindow.PenColor = "orange" GraphicsWindow.BrushColor = "orange" If getgame = 1 Then enemy = Shapes.AddEllipse(50, 50) Shapes.Move(enemy, rx, ry) Controls.SetButtonCaption(count, getcount + 1) getcount = Controls.GetButtonCaption(count) If getcount = 2 Then Sound.PlayMusic("03 a") Controls.SetButtonCaption(game, 0) GraphicsWindow.PenColor = "dodgerblue" GraphicsWindow.BrushColor = "dodgerblue" cover = Shapes.AddRectangle(800, 420) Shapes.SetOpacity(cover, 0) For appear = 0 To 100 Shapes.SetOpacity(cover, appear) Program.Delay(5) EndFor GraphicsWindow.BrushColor = "black" retry = Controls.AddButton("Retry", 370, -30) Controls.SetSize(retry, 60, 30) Shapes.Animate(retry, 370, 390, 400) EndIf EndIf EndSub 'BUTTON_DOWN Controls.ButtonClicked = bc Sub bc If Controls.LastClickedButton = retry Then Sound.PlayClick() Controls.Remove(retry) Controls.SetButtonCaption(score, 0) Timer.Interval = 2000 Controls.SetButtonCaption(game, 1) EndIf EndSub End>QHN542.sb< Start>QHV273.sb< GraphicsWindow.BrushColor = "Wheat" x = 400 y = 100 Size = 10 Angle = Size / 4 GraphicsWindow.DrawRectangle(x,y,Size,Size) GraphicsWindow.DrawLine(x,y,x + Angle ,y - Angle ) GraphicsWindow.DrawLine(x + Angle ,y - Angle ,x + Size + Angle ,y - Angle ) GraphicsWindow.DrawLine(x + Size + Angle ,y - Angle ,x + Size,y) GraphicsWindow.DrawLine(x + Size + Angle ,y - Angle ,x + Size + Angle ,y + Size - Angle ) GraphicsWindow.DrawLine(x + Size + Angle ,y + Size - Angle ,x + Size,y + Size) End>QHV273.sb< Start>QHW722.sb< ' Animation of LINES ' mahreen miangul ' ApRiL 2019 GraphicsWindow.Width = 800 GraphicsWindow.Height = 600 GraphicsWindow.BackgroundColor = "LightYellow" GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 55 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "Silver" ' Text shadow color GraphicsWindow.DrawText(20, 20, "mahreen!") ' Shadow position/text GraphicsWindow.DrawText(550, 440, "miangul!") GraphicsWindow.BrushColor = "RosyBrown" ' Text color GraphicsWindow.DrawText(20, 25, "mahreen!") ' Position and text GraphicsWindow.DrawText(550, 445, "miangul!") '============================== Makesprite() ============================== SPRITE_init() add_shapes1() '--------------------------------------------------------------mahreen//miangul-------------------------------------------------- GraphicsWindow.brushColor= "greenyellow"'------1 miangul = shapes.addtriangle(710,240,725,240,725,260) Shapes.Move(miangul, 0,0) Shapes.Animate(miangul, -610, 80, 2000) GraphicsWindow.brushColor= "yellowgreen"'------2 miangul = shapes.addtriangle(710,240,700,260,725,260) Shapes.Move(miangul, 0,0) Shapes.Animate(miangul, -615, 80, 2000) GraphicsWindow.brushColor = GraphicsWindow.GetRandomColor()'------------3 miangul = shapes.addtriangle(750,270,765,270,760,240) Shapes.Move(miangul, 0,0) Shapes.Animate(miangul, -635, 80, 2000) GraphicsWindow.penColor= "darkslategray"'------4 GraphicsWindow.Penwidth = 6 miangul = shapes.addline(40, 0, 80, 0) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul, 60, 400, 2000) GraphicsWindow.penColor= "mediumslateblue"'------5 GraphicsWindow.PenWidth = 6 miangul = shapes.addline(0, 40, 0, 80) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul, 100, 320, 2000) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor()'------------6 GraphicsWindow.PenWidth = 6 miangul = shapes.addline(0, 40, 00, 95) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul,107, 318, 2000) Shapes.rotate(miangul, -45) 'Shapes.getopacity(80) 'Shapes.Zoom(miangul, 3, 5) GraphicsWindow.brushColor = GraphicsWindow.GetRandomColor()'------------7 GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() GraphicsWindow.PenWidth = 4 miangul = shapes.addrectangle(20,40) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul, 150, 320, 2000) GraphicsWindow.brushColor = GraphicsWindow.GetRandomColor()'------------8 GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() GraphicsWindow.PenWidth = 4 miangul = shapes.addrectangle(40,20) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul, 170, 340, 2000) GraphicsWindow.brushColor = GraphicsWindow.GetRandomColor()'------------9 GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() GraphicsWindow.PenWidth = 4 miangul = shapes.addellipse(30,30) Shapes.Move(miangul, 800, 0) Shapes.Animate(miangul, 170, 310, 2000) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>Eyes<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< graphicswindow.brushcolor = "white 'graphicswindow.brushcolor = "blue graphicswindow.penwidth = 4 graphicswindow.pencolor = "black circle = shapes.addEllipse(80, 80) Shapes.Move(circle, 280, 50) graphicswindow.pencolor = "white 'graphicswindow.brushcolor = "blue rectangle = Shapes.Addrectangle(50, 80) Shapes.Move(rectangle, 310, 50) graphicswindow.brushcolor = "white 'graphicswindow.brushcolor = "green graphicswindow.penwidth = 4 graphicswindow.pencolor = "black circle = shapes.addEllipse(80, 80) Shapes.Move(circle, 310, 50) graphicswindow.brushcolor = "white 'graphicswindow.brushcolor = "green graphicswindow.pencolor = "white rectangle = Shapes.Addrectangle(50, 80) Shapes.Move(rectangle, 310, 50) graphicswindow.brushcolor = "white graphicswindow.penwidth = 4 graphicswindow.pencolor = "black circle = shapes.addEllipse(80, 80) Shapes.Move(circle, 450, 50) graphicswindow.pencolor = "white rectangle = Shapes.Addrectangle(50, 80) Shapes.Move(rectangle, 480, 50) graphicswindow.brushcolor = "white graphicswindow.penwidth = 4 graphicswindow.pencolor = "black circle = shapes.addEllipse(80, 80) Shapes.Move(circle, 480, 50) graphicswindow.brushcolor = "white graphicswindow.pencolor = "white rectangle = Shapes.Addrectangle(50, 80) Shapes.Move(rectangle, 480, 50) graphicswindow.brushcolor = "black graphicswindow.pencolor = "black circle = shapes.addEllipse(15, 15) Shapes.Move(circle, 330, 100) graphicswindow.pencolor = "black circle = shapes.addEllipse(15, 15) Shapes.Move(circle, 500, 100) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>Body//Lines<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() 'graphicswindow.pencolor = "black graphicswindow.penwidth = 4 line1 = shapes.addline(5, 15, 30, 15) Shapes.Move(line1, 270, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(5, 15, 30, 15) Shapes.Move(line2, 320, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(5, 15, 30, 15) Shapes.Move(line3, 370, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line4 = shapes.addline(5, 15, 30, 15) Shapes.Move(line4, 420, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line5 = shapes.addline(5, 15, 30, 15) Shapes.Move(line5, 470, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line6 = shapes.addline(5, 15, 30, 15) Shapes.Move(line6, 520, 0) 'graphicswindow.pencolor = "black GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() graphicswindow.penwidth = 4 line1 = shapes.addline(10, 5, 10, 85) Shapes.Move(line1, 250, 50) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(10, 5, 10, 85) Shapes.Move(line2, 250, 150) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(10, 5, 10, 85) Shapes.Move(line3, 250, 250) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line4 = shapes.addline(10, 5, 10, 85) Shapes.Move(line4, 570, 50) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line5 = shapes.addline(10, 5, 10, 85) Shapes.Move(line5, 570, 150) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line6 = shapes.addline(10, 5, 10, 85) Shapes.Move(line6, 570, 250) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1A = shapes.addline(10, 0, -30, 70) Shapes.Move(line1A, 405, 140) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2A = shapes.addline(10, 0, 50, 70) Shapes.Move(line2A, 415, 140) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1B = shapes.addline(10, 0, -30, 70) Shapes.Move(line1B, 405, 460) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2B = shapes.addline(10, 0, 50, 70) Shapes.Move(line2B, 415, 460) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line = shapes.addline(-50, 160, 80, 160) Shapes.Move(line, 400, 180) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(-10, 30, 10, 110) Shapes.Move(line1, 340, 210) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(10, 110, 30, 30) Shapes.Move(line2, 470, 210) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(0, 30, 0, 120) Shapes.Move(line1, 400, 330) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(0, 30, 0, 120) Shapes.Move(line2, 440, 330) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(0, 0, 80, 0) Shapes.Move(line1, 470, 540) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(0, 0, 80, 0) Shapes.Move(line2, 290, 540) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(5, 15, 30, 15) Shapes.Move(line1, 300, 390) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(5, 15, 30, 15) Shapes.Move(line2, 350, 390) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(5, 15, 30, 15) Shapes.Move(line3, 460, 390) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line4 = shapes.addline(5, 15, 30, 15) Shapes.Move(line4, 510, 390) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(5, 15, 40, 15) Shapes.Move(line1, 200, 130) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(0, 15, 15, 65) Shapes.Move(line2, 210, 145) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(0, 15, 40, 15) Shapes.Move(line3, 600, 130) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line4 = shapes.addline(0, 15, -15, 65) Shapes.Move(line4, 635, 140) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(250, -30, 250, 30) Shapes.Move(line1, 0, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(250, 40, 280, 20) Shapes.Move(line2, -15, -15) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(250, 20, 280, 40) Shapes.Move(line3, -15, -15) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(250, -30, 250, 30) Shapes.Move(line1, 330, 0) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(250, 40, 280, 20) Shapes.Move(line2, 315, -15) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(250, 20, 280, 40) Shapes.Move(line3, 315, -15) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(250, -18, 250, 18) Shapes.Move(line1, 10, 380) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(250, 40, 280, 20) Shapes.Move(line2, -5, 350) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(250, 20, 280, 40) Shapes.Move(line3, -5, 350) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line1 = shapes.addline(250, -18, 250, 18) Shapes.Move(line1, 330, 380) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line2 = shapes.addline(250, 40, 280, 20) Shapes.Move(line2, 315, 350) GraphicsWindow.penColor = GraphicsWindow.GetRandomColor() line3 = shapes.addline(250, 20, 280, 40) Shapes.Move(line3, 315, 350) ' Human-Cell mm_init() shape=mm Name="mm" add_shapes() ' Add shapes // Human-Cell Sub add_shapes For M=1 To Array.GetItemCount(scale) ss=scale[M] SName=Name+"_"+M for i=1 To Array.GetItemCount(shape) GraphicsWindow.PenWidth = shape[i]["pw"] GraphicsWindow.BrushColor = shape[i]["bc"] GraphicsWindow.penColor = shape[i]["pc"] If shape[i]["func"]="ell" Then shp[SName][i] = Shapes.AddEllipse(shape[i]["width"]*ss, shape[i]["height"]*ss) ElseIf shape[i]["func"]="rect" Then shp[SName][i] = Shapes.AddRectangle(shape[i]["width"]*ss, shape[i]["height"]*ss) ElseIf shape[i]["func"]="tri" Then shp[SName][i] = Shapes.Addtriangle(shape[i]["x1"]*ss, shape[i]["y1"]*ss,shape[i]["x2"]*ss, shape[i]["y2"]*ss, shape[i]["x3"]*ss, shape[i]["y3"]*ss) ElseIf shape[i]["func"]="line" Then shp[SName][i] = Shapes.Addline(shape[i]["x1"]*ss, shape[i]["y1"]*ss,shape[i]["x2"]*ss, shape[i]["y2"]*ss) ElseIf shape[i]["func"]="txt" Then GraphicsWindow.FontSize=shape[i]["Size"] shp[SName][i] = Shapes.Addtext(shape[i]["Letter"]) EndIf Shapes.Animate(shp[SName][i], shape[i]["x"]*ss+shX[M], shape[i]["y"]*ss+shY[M], 500) Shapes.Rotate(shp[SName][i], Shape[i]["angle"]) EndFor EndFor endsub ' Add Sprites Sub add_shapes1 For M=1 To Array.GetItemCount(s) For N=1 To Array.GetItemCount(s[M]) ss=s[M][N] _shx=shx[M][N] _shY=shY[M][N] _shape=shape[M] NMB=M+":"+N For i=1 To Array.GetItemCount(_shape) GraphicsWindow.PenWidth = _shape[i]["pw"] GraphicsWindow.BrushColor = _shape[i]["bc"] GraphicsWindow.penColor = _shape[i]["pc"] If _shape[i]["func"]="ell" Then shp[NMB][i] = Shapes.AddEllipse(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="rect" Then shp[NMB][i] = Shapes.AddRectangle(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="tri" Then shp[NMB][i] = Shapes.Addtriangle(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss, _shape[i]["x3"]*ss, _shape[i]["y3"]*ss) ElseIf _shape[i]["func"]="line" Then shp[NMB][i] = Shapes.Addline(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss) EndIf Shapes.Animate(shp[NMB][i], _shape[i]["x"]*ss+_shX, _shape[i]["y"]*ss+_shY, 500) Shapes.Rotate(shp[NMB][i], _Shape[i]["angle"]) EndFor EndFor EndFor EndSub ' mahreen miangul//3 Sub mm_init scale ="1=0.4;2=0.4;3=0.4" shX ="1=-240;2=-150;3=-200" shY ="1=40;2=40;3=100" mm[1]="func=ell;X=605;Y=85;width=280;height=280;bc=brown;pc=brown;pw=0"' ell 1 mm[2]="func=ell;X=610;Y=90;width=270;height=270;bc=lightsalmon;pc=darkslategray;pw=0"' ell 2 mm[3]="func=ell;X=640;Y=120;width=210;height=210;bc=cornflowerblue;pc=darkslategray;pw=0"' ell e mm[4]="func=ell;X=650;Y=130;width=190;height=190;bc=peachpuff;pc=darkslategray;pw=4"' ell 4 mm[5]="func=ell;X=670;Y=190;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 1 mm[6]="func=ell;X=660;Y=240;width=15;height=15;bc=Greenyellow;pc=darksltegray;pw=2"' R2 mm[7]="func=ell;X=680;Y=220;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 3 mm[8]="func=ell;X=800;Y=180;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 4 mm[9]="func=ell;X=766;Y=200;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 5 mm[10]="func=ell;X=822;Y=225;width=15;height=15;bc=Greenyellow;pc=darksltegray;pw=2"' R 6 mm[11]="func=ell;X=811;Y=202;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 7 mm[12]="func=ell;X=788;Y=212;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 8 mm[13]="func=ell;X=788;Y=212;width=15;height=15;bc=Greenyellow;pc=darkslategray;pw=2"' R 9 mm[14]="func=ell;X=766;Y=305;width=15;height=15;bc=greenyellow;pc=darkslatgray;pw=2"' R 10 mm[15]="func=ell;X=705;Y=195;width=20;height=30;bc=powderblue;pc=darkslategray;pw=2"' N1 mm[16]="func=ell;X=715;Y=185;width=30;height=40;bc=powderblue;pc=darkslategray;pw=2"' N2 mm[17]="func=ell;X=735;Y=180;width=35;height=40;bc=powderblue;pc=darkslategray;pw=2"' N3 mm[18]="func=ell;X=770;Y=190;width=20;height=30;bc=powderblue;pc=darkslategray;pw=2"' N4 'mm[18]="func=ell;X=778;Y=202;width=10;height=20"' N5 'mm[19]="func=ell;X=770;Y=202;width=10;height=20"' N6 'mm[20]="func=ell;X=700;Y=210;width=15;height=20"' N7 mm[19]="func=ell;X=710;Y=190;width=70;height=70;bc=powderblue;"'N\ endsub Sub SPRITE_init ' 4 Trees s[1]="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=0.2;8=0.2;9=0.2;10=0.2;11=0.2;12=0.2;13=0.2;14=0.2" shX[1]="1=600;2=630;3=660;4=690;5=720;6=750;7=615;8=645;9=675;10=705;11=735;12=645;13=675;14=705" shY[1]="1=-25;2=-25;3=-25;4=-25;5=-25;6=-25;7=5;8=5;9=5;10=5;11=5;12=30;13=30;14=30" shape[1][1]="func=ell;X=0;Y=188;width=200;height=140;bc=Green;pc=Green;pw=2" shape[1][2]="func=ell;X=10;Y=277;width=80;height=60;bc=Green;pc=Green;pw=2" shape[1][3]="func=ell;X=4;Y=255;width=80;height=70;bc=Green;pc=Green;pw=2;" shape[1][4]="func=ell;X=0;Y=191;width=80;height=80;bc=Green;pc=Green;pw=2;" shape[1][5]="func=ell;X=40;Y=177;width=80;height=80;bc=Green;pc=Green;pw=2" shape[1][6]="func=ell;X=100;Y=177;width=120;height=80;bc=Green;pc=Green;pw=2" shape[1][7]="func=ell;X=130;Y=240;width=100;height=80;bc=Green;pc=Green;pw=2;" shape[1][8]="func=ell;X=130;Y=260;width=100;height=80;bc=Green;pc=Green;pw=2;" shape[1][9]="func=rect;X=80;Y=322;width=60;height=100;bc=saddlebrown;pc=darkslatgray;pw=2" shape[1][10]="func=tri;X1=140;Y1=262;X2=110;Y2=322;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 shape[1][11]="func=tri;X1=140;Y1=262;X2=170;Y2=262;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0" shape[1][12]="func=tri;X1=50;Y1=262;X2=96;Y2=262;X3=80;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 shape[1][13]="func=tri;X1=96;Y1=262;X2=80;Y2=322;X3=126;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0" ' 8 Apples s[2] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=0.2;8=0.2;9=0.2;10=0.2;11=0.2;12=0.2;13=0.2;14=0.2;15=0.2;16=0.2;17=.2;18=.2;18=.2" shX[2] ="1=-100;2=-60;3=-20;4=20;5=60;6=100;7=140;8=180;9=220;10=140;11=180;12=220;13=240;14=280;15=320;16=360;17=400;18=440" shY[2] ="1=480;2=480;3=480;4=480;5=480;6=480;7=480;8=480;9=480;10=540;11=540;12=540;13=540;14=540;15=540;16=540;17=540;18=540" shape[2][1] = "func=rect;x=626;y=110;width=20;height=60;angle=30;bc=yellowgreen;pw=0;" shape[2][2] = "func=ell;x=511;y=148;width=150;height=150;bc=crimson;pw=0;" shape[2][3] = "func=ell;x=603;y=148;width=150;height=150;bc=crimson;pw=0;" shape[2][4] = "func=ell;x=594;y=188;width=40;height=40;bc=snow;pw=0;" shape[2][5] = "func=ell;x=633;y=188;width=40;height=40;bc=snow;pw=0;" shape[2][6] = "func=ell;x=614;y=196;width=15;height=15;bc=darkslategray;pw=0;" shape[2][7] = "func=ell;x=635;y=196;width=15;height=15;angle=7;bc=darkslategray;pw=0;" shape[2][8] = "func=rect;x=600;y=250;width=80;height=20;angle=-5;bc=purple;pw=0;" ' mahreen miangul--1 s[3] ="1=0.4" ' scale shx[3] ="1= -150" ' initial x -position shy[3] ="1= 334" ' initial y-position ' House s[4]="1=0.8" shX[4]="1=660" shY[4]="1=375" ' Tree s[5]="1=0.2;2=.2;3=.2;4=.2;" shX[5]="1=660;2=690;3=660;4=690" shY[5]="1=260;2=260;3=290;4=290" ' 5,6,13,14 shape[5]=shape[1] 'Apple s[6] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=.2;8=.2;" shX[6] ="1=500;2=540;3=500;4=560;5=500;6=540;7=580;8=620" shY[6] ="1=80;2=180;3=280;4=370;5=500;6=500;7=500;8=500" shape[6]=shape[2] endsub End>QHW722.sb< Start>QJB811.sb< 'program l=300 GraphicsWindow.height=700 GraphicsWindow.width=1366 GraphicsWindow.top=0 GraphicsWindow.left=0 graphicsWindow.PenWidth =0 qq=shapes.AddRectangle (l,5) qq1=shapes.AddRectangle (5,40) GraphicsWindow.BackgroundColor = GraphicsWindow.GetColorFromRGB( 0,0,70) LDPhysics.AddFixedShape (qq, 0, 0) LDPhysics.AddFixedShape (qq1, 0, 0) LDPhysics.Reset() LDPhysics.SetGravity (1,16) ' moon gravity 100/6 = !!! While "true" x=x+1/20 'Shapes.Rotate (qq x+90) LDPhysics.SetPosition (qq 300+LDMath.cos(x-90)*l/2 300+LDMath.sin(x-90)*l/2 x+90) LDPhysics.SetPosition (qq1 300+LDMath.cos(x-90)*l 300+LDMath.sin(x-90)*l x+90) LDPhysics.DoTimestep () Program.Delay (12) If Math.Remainder (x,3)=0 And cc<250 Then If ds then ds = "false else ds="true GraphicsWindow.BrushColor=LDColours.HSLtoRGB (Math.GetRandomNumber(360),1,0.5) v=Math.GetRandomNumber(60) ee=shapes.AddEllipse (v, v) cc=cc+1 GraphicsWindow.Title =cc LDPhysics.AddMovingShape (ee, 1, 1, 2) LDPhysics.SetBullet (ee) LDPhysics.SetPosition (ee, 300, 10, 0) EndIf Else ds="false endif EndWhile End>QJB811.sb< Start>QJF184.sb< '--- By ---' '--- Louis Dench ---' '--- Maths game with scoreboard! ---' ' The following line could be harmful and has been automatically commented. ' File.CreateDirectory(Program.Directory+"\Highscores") timesplayed = 1 ' The following line could be harmful and has been automatically commented. ' s = File.ReadContents(Program.Directory+"\Highscores\timesplayed.txt") timesplayed = s + 1 ' The following line could be harmful and has been automatically commented. ' File.WriteContents(Program.Directory+"\Highscores\timesplayed.txt", timesplayed) Begin: Points = 0 QN = 0 TextWindow.ForegroundColor = "White" TextWindow.WriteLine("Welcome to mad maths challenge what is your name?") TextWindow.ForegroundColor = "Yellow" name = TextWindow.Read() TextWindow.ForegroundColor = "White" TextWindow.Clear() TextWindow.Write("Hello ") TextWindow.ForegroundColor = "Yellow" TextWindow.Write(name) TextWindow.ForegroundColor = "White" TextWindow.Write(" press enter to start.") TextWindow.WriteLine(" ") TextWindow.Read() For Q = 1 To 10 TextWindow.Clear() QN = QN + 1 Sym = Math.GetRandomNumber(3) Number1 = Math.GetRandomNumber(30) Number2 = Math.GetRandomNumber(30) If Sym = 2 Then Answer = Number1 - Number2 TextWindow.WriteLine(QN+") What is " +Number1+ " - " +Number2+ " ?") TextWindow.ForegroundColor = "Yellow" Answer1 = TextWindow.Read() TextWindow.ForegroundColor = "White" If Answer1 = Answer Then TextWindow.ForegroundColor = "Green" TextWindow.WriteLine("Correct") TextWindow.ForegroundColor = "White" Points = Points + 1 Else TextWindow.ForegroundColor = "Red" TextWindow.WriteLine("") TextWindow.Write("Incorrect") TextWindow.ForegroundColor = "White" TextWindow.Write("The answer was: " + Answer) EndIf ElseIf Sym = 3 Then Answer = Number1 + Number2 TextWindow.WriteLine(QN+") What is " +Number1+ " + " +Number2+ " ?") TextWindow.ForegroundColor = "Yellow" Answer1 = TextWindow.Read() TextWindow.ForegroundColor = "White" If Answer1 = Answer Then TextWindow.ForegroundColor = "Green" TextWindow.WriteLine("Correct") TextWindow.ForegroundColor = "White" Points = Points + 1 Else TextWindow.ForegroundColor = "Red" TextWindow.WriteLine("Incorrect") TextWindow.ForegroundColor = "White" TextWindow.Write("The answer was: " + Answer) EndIf Else Answer = Number1 * Number2 TextWindow.WriteLine(QN+") What is " +Number1+ " x " +Number2+ " ?") TextWindow.ForegroundColor = "Yellow" Answer1 = TextWindow.Read() TextWindow.ForegroundColor = "White" If Answer1 = Answer Then TextWindow.ForegroundColor = "Green" TextWindow.WriteLine("Correct") TextWindow.ForegroundColor = "White" Points = Points + 1 Else TextWindow.ForegroundColor = "Red" TextWindow.WriteLine("Incorrect") TextWindow.ForegroundColor = "White" TextWindow.Write("The answer was: " + Answer) EndIf EndIf Program.Delay(500) TextWindow.Clear() EndFor If Points >= 6 Then TextWindow.Clear() TextWindow.Write("Well done " ) TextWindow.ForegroundColor = "Yellow" TextWindow.Write(name) TextWindow.ForegroundColor = "White" TextWindow.Write(" your score was ") TextWindow.ForegroundColor = "Cyan" TextWindow.Write(Points) TextWindow.WriteLine(" ") TextWindow.ForegroundColor = "White" Else TextWindow.ForegroundColor = "Yellow" TextWindow.Write(name) TextWindow.ForegroundColor = "White" TextWindow.Write(" you could have done better your score was " ) TextWindow.ForegroundColor = "Cyan" TextWindow.Write(Points) TextWindow.WriteLine(" ") TextWindow.ForegroundColor = "White" EndIf ' The following line could be harmful and has been automatically commented. ' s = File.ReadLine(Program.Directory+"\Highscores\timesplayed.txt", 1) TextWindow.WriteLine(" ") ' The following line could be harmful and has been automatically commented. ' File.WriteLine(Program.Directory+"\Highscores\score.txt", s, name+ " " +points) TextWindow.WriteLine("Press 'Enter' to end the program.") ' The following line could be harmful and has been automatically commented. ' b = File.ReadContents(Program.Directory+"\Highscores\score.txt") TextWindow.WriteLine("") TextWindow.ForegroundColor = "cyan" TextWindow.WriteLine("=---= Score Board =---=") TextWindow.ForegroundColor = "Yellow" TextWindow.WriteLine(b) Retry = TextWindow.Read() Program.End() End>QJF184.sb< Start>QJH089.sb< TextWindow.Title = "Enter your number" start: TextWindow.WriteLine("Enter a number that's not between 5 and 10.") number = TextWindow.ReadNumber() While number < 5 Or number > 10 TextWindow.WriteLine(number) Goto start EndWhile TextWindow.WriteLine("ERROR") End>QJH089.sb< Start>QJL661.sb< GraphicsWindow.Title="Analog Clock with Ticks" GraphicsWindow.Width=220 GraphicsWindow.Height=220 GraphicsWindow.BrushColor="Green" GraphicsWindow.FillEllipse(10,10,200,200) GraphicsWindow.BrushColor="Black" GraphicsWindow.DrawEllipse(10,10,200,200) GraphicsWindow.PenWidth=5 While 1=1 LenS = Math.Max(87, 92-15*Math.Remainder(Clock.Second, 5)) AngleS = Math.Pi*Clock.Second/30 AngleM = Math.Pi*Clock.Minute/30 + AngleS/60 AngleH = Math.Pi*Clock.Hour/6 + AngleM/60 GraphicsWindow.BrushColor="Green" GraphicsWindow.FillEllipse(25,25,170,170) GraphicsWindow.PenColor="LightGreen" GraphicsWindow.DrawLine(110,110,110+LenS*Math.Sin(AngleS),110-LenS*Math.Cos(AngleS)) GraphicsWindow.PenColor="Black" GraphicsWindow.DrawLine(110,110,110+75*Math.Sin(AngleM),110-75*Math.Cos(AngleM)) GraphicsWindow.DrawLine(110,110,110+60*Math.Sin(AngleH),110-60*Math.Cos(AngleH)) Program.Delay(500) EndWhile 'Title: An analog clock. 'Special Feature: after one minute, has Hour Ticks on the face 'Most code is for presentation purposes only 'Can be functionally reproduced in 6 lines 'The Tick Trick: 'LenS (the length of the Second Hand) changes based on the 'current Second, and the program only erases MOST of the 'clock face each redraw. Any part of the second hand outside 'of the erase area stays behind and forms the tick marks. End>QJL661.sb< Start>QJN779.sb< 'Replacing Z values with Z + 0.383 and Save in "New DataBase.txt" ' The following line could be harmful and has been automatically commented. ' buffer = File.ReadContents(Program.Directory + "\DataBase.txt") If buffer = "" Then HandleFileError() EndIf bufferSize = Text.GetLength(buffer) While i <= bufferSize i = i + 1 char = Text.GetSubText(buffer, i, 1) If char = "Z" Then Z_index = i i = i + 1 char = Text.GetSubText(buffer, i, 1) While char * 1 = char Or char = "." appendValue = Text.Append(appendValue, char) i = i + 1 char = Text.GetSubText(buffer, i, 1) EndWhile newValue = appendValue + 0.383 appendValue = "" head = Text.GetSubText(buffer, 1, Z_index) tail = Text.GetSubTextToEnd(buffer, i) buffer = head + newValue + tail newValue = "" EndIf EndWhile ' The following line could be harmful and has been automatically commented. ' If File.WriteContents(Program.Directory + "\New DataBase.txt", buffer) = "SUCCESS" Then TextWindow.WriteLine("SUCCESS: New DataBase.txt created in " + Program.Directory) Else HandleFileError() EndIf Sub HandleFileError TextWindow.WriteLine("File ERROR!") TextWindow.Pause() Program.End() EndSub End>QJN779.sb< Start>QJN781.sb< For x=1 To 14 LDTextWindow.SetColour (x LDColours.HSLtoRGB (0 1 (x*3)/100+.2)) EndFor For x=1 To 14 LDTextWindow.SetColours (x 15-x) TextWindow.WriteLine (">>> SmallBasic TextWindowColorTest <<<") EndFor While "true For x=1 To 14 LDTextWindow.SetColour (x LDColours.HSLtoRGB (math.Remainder (ii 360) 1 (x*3)/100+.2)) EndFor Program.Delay (20) ii=ii+1 EndWhile End>QJN781.sb< Start>QJP554-0.sb< GraphicsWindow.BackgroundColor="tan GraphicsWindow.PenWidth=0 GraphicsWindow.Width=600 GraphicsWindow.Height=600 GraphicsWindow.Title="Triangles Clock cc="⑩ ⑪ ⑫ ① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ct=LDText.Split(cc " ") GraphicsWindow.FontSize=33 While 1=1 GraphicsWindow.BrushColor="tan GraphicsWindow.Clear() For x=0 To 11 sx=LDMath.Sin(180-x*30)*230+300 cx=LDMath.Cos(180-x*30)*230+300 tx=Shapes.AddText( ct[12-x]) LDShapes.Centre(tx cx sx) if x=9 then LDShapes.AnimateZoom(tx 2000 30 1.3 1.3) EndIf LDEffect.DropShadow(tx "shadowdepth=3") EndFor h=Clock.Hour m=Clock.Minute s=Clock.Second sx=LDMath.Sin(90-(h*30+m/2))*200 cx=LDMath.Cos(90-(h*30+m/2))*200 GraphicsWindow.BrushColor="red t=Shapes.AddTriangle(300 300 300+cx 300 300+cx 300-sx) sx=LDMath.Sin(90-m*6)*200 cx=LDMath.Cos(90-m*6)*200 GraphicsWindow.BrushColor="#990000ee t=Shapes.AddTriangle(300 300 300+cx 300 300+cx 300-sx) GraphicsWindow.BrushColor="#44333366 For x=s To 59 sx=LDMath.Sin(90-x*6)*200 cx=LDMath.Cos(90-x*6)*200 t=Shapes.AddTriangle(300 300 300+cx 300 300+cx 300-sx) Program.Delay(999) Shapes.Remove(t) EndFor EndWhile End>QJP554-0.sb< Start>QJP554-1.sb< GraphicsWindow.PenWidth=0 GraphicsWindow.Width=600 GraphicsWindow.Height=600 bbb=LDShapes.BrushGradient("1=tan;2=tan;3=brown" "") LDGraphicsWindow.BackgroundBrush(bbb) GraphicsWindow.Title="Roman Clock cc="Ⅹ Ⅺ Ⅻ Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ ct=LDText.Split(cc " ") GraphicsWindow.FontSize=33 i1=ImageList.LoadImage("e:\h1.png") i2=ImageList.LoadImage("e:\h2.png") s7=.45 LDImage.Resize(i1 ImageList.GetWidthOfImage(i1)*s7 ImageList.GetHeightOfImage(i1)*s7) LDImage.Resize(i2 ImageList.GetWidthOfImage(i2)*s7 ImageList.GetHeightOfImage(i2)*s7) LDImage.ReplaceColour(i1 "white" "transparent" 33) LDImage.ReplaceColour(i2 "white" "transparent" 33) GraphicsWindow.BrushColor="tan For x=0 To 11 sx=LDMath.Sin(180-x*30)*230+300 cx=LDMath.Cos(180-x*30)*230+300 tx=Shapes.AddText( ct[12-x]) LDShapes.Centre(tx cx sx) If x=9 Then LDShapes.AnimateZoom(tx 2000 30 1.3 1.3) EndIf LDEffect.DropShadow(tx "shadowdepth=3") EndFor ss1=Shapes.AddImage(i1) ss2=Shapes.AddImage(i2) Shapes.Move(ss1 285 270) Shapes.Move(ss2 282 280) GraphicsWindow.BrushColor="#44333333 t=Shapes.AddTriangle(300 295 100 300 300 305) While 1=1 h=Clock.Hour m=Clock.Minute s=Clock.Second ldShapes.RotateAbout(ss1 300 300 h*30+m/2-90) ldShapes.RotateAbout(ss2 300 300 (m)*6-90) For x=s To 59 LDShapes.RotateAbout(t 300 300 x*6+90) Program.Delay(999) EndFor EndWhile End>QJP554-1.sb< Start>QJP611-1.sb< St = 4 For Z = 0 To 255 Step St For X = 0 To 255 Step St For Y = 0 To 255 Step St GraphicsWindow.SetPixel(X / St + Z, Y / St + Z, GraphicsWindow.GetColorFromRGB(X, Y, Z)) Endfor Endfor Endfor End>QJP611-1.sb< Start>QJP611.sb< For Z = 0 To 255 Step 5 For X = 0 To 255 Step 5 For Y = 0 To 255 Step 5 GraphicsWindow.SetPixel(X/5,Z/5,GraphicsWindow.GetColorFromRGB(Y,Z,X)) TextWindow.WriteLine(Z+"_"+X+"_"+Y) Endfor Endfor Endfor End>QJP611.sb< Start>QJQ087.sb< GraphicsWindow.BackgroundColor = "SteelBlue" For i = 1 To 6 CorredorGif = ImageList.LoadImage("http://ingenieriasimple.com/smallbasic/Corredor0" + i + ".png") CorredorSh[i][1] = Shapes.AddImage(CorredorGif) Shapes.Zoom(CorredorSh[i][1],0.5,0.5) Shapes.HideShape(CorredorSh[i][1]) CorredorGif = ImageList.LoadImage("http://ingenieriasimple.com/smallbasic/Corredor0" + i + "r.png") CorredorSh[i][-1] = Shapes.AddImage(CorredorGif) Shapes.Zoom(CorredorSh[i][-1],0.5,0.5) Shapes.HideShape(CorredorSh[i][-1]) EndFor Shapes.ShowShape(CorredorSh[1][1]) Corredor = 1 CorredorDir = 1 Terron = ImageList.LoadImage("http://ingenieriasimple.com/smallbasic/TerronG.png") Timer.Interval = 160 Timer.Tick = CaeCorredor GraphicsWindow.KeyDown = CambiaDireccionCorredor For i = 1 To 4 Tierra[i] = Shapes.AddImage(Terron) Shapes.HideShape(Tierra[i]) Shapes.Move(Tierra[i],Math.GetRandomNumber(GraphicsWindow.Width),GraphicsWindow.Height*(0.25*i)) Shapes.ShowShape(Tierra[i]) EndFor Sub CaeCorredor DeltaXCo = 15 DeltaYCo = 3 DeltaYTrra = 10 CurXCo = Shapes.GetLeft(CorredorSh[Corredor][1]) CurYCo = Shapes.GetTop(CorredorSh[Corredor][1]) For i = 1 To 4 CurXTrra = Shapes.GetLeft(Tierra[i]) CurYTrra = Shapes.GetTop(Tierra[i]) 'GraphicsWindow.DrawEllipse(CurXTrra+7,CurYTrra,52,5) 'GraphicsWindow.DrawEllipse(CurXCo+25,CurYCo+90,35,5) If Math.Abs(CurXTrra - CurXCo - 18) < 52 And Math.Abs(CurYTrra - CurYCo - 90) < 15 Then DeltaYCo = - DeltaYTrra EndIf If CurYTrra <= -50 Then Shapes.Move(Tierra[i],Math.GetRandomNumber(GraphicsWindow.Width),GraphicsWindow.Height) EndIf EndFor Shapes.HideShape(CorredorSh[Corredor][1]) Shapes.HideShape(CorredorSh[Corredor][-1]) Corredor = Math.Remainder(Corredor,6) + 1 Shapes.ShowShape(CorredorSh[Corredor][CorredorDir]) For i = 1 To 6 If i = Corredor Then Shapes.Animate(CorredorSh[i][1],CurXCo + DeltaXCo*CorredorDir,CurYCo + DeltaYCo,150) Shapes.Animate(CorredorSh[i][-1],CurXCo + DeltaXCo*CorredorDir,CurYCo + DeltaYCo,150) Else Shapes.Move(CorredorSh[i][1],CurXCo + DeltaXCo*CorredorDir,CurYCo + DeltaYCo) Shapes.Move(CorredorSh[i][-1],CurXCo + DeltaXCo*CorredorDir,CurYCo + DeltaYCo) EndIf EndFor For i = 1 To 4 CurXTrra = Shapes.GetLeft(Tierra[i]) CurYTrra = Shapes.GetTop(Tierra[i]) Shapes.Animate(Tierra[i],CurXTrra,CurYTrra-DeltaYTrra,150) EndFor EndSub Sub CambiaDireccionCorredor If GraphicsWindow.LastKey = "Left" Then CorredorDir = -1 ElseIf GraphicsWindow.LastKey = "Right" Then CorredorDir = 1 EndIf EndSub End>QJQ087.sb< Start>QJR555.sb< OnButtonClicked() GraphicsWindow.Show() GraphicsWindow.Title ="Moba 2" GraphicsWindow.Width = 540 GraphicsWindow.Height = 450 GraphicsWindow.Top = 150 GraphicsWindow.Left = 100 GraphicsWindow.BrushColor = "Red" schalt1 = Controls.AddTextBox(10,10)' A Controls.SetSize(schalt1,30,20) schalt2 = Controls.AddTextBox(50,40)' W Controls.SetSize(schalt2,30,20) schalt3 = Controls.AddTextBox(50,70)' H Controls.SetSize(schalt3,30,20) schalt4 = Controls.AddTextBox(50,100)' K Controls.SetSize(schalt4,30,20) schalt5 = Controls.AddTextBox(50,130)' S Controls.SetSize(schalt5,30,20) schalt6 = Controls.AddTextBox(10,40)' C Controls.SetSize(schalt6,30,20) schalt7 = Controls.AddTextBox(10,70)' F Controls.SetSize(schalt7,30,20) schalt8 = Controls.AddTextBox(10,100)' G Controls.SetSize(schalt8,30,20) schalt9 = Controls.AddTextBox(10,130)' J Controls.SetSize(schalt9,30,20) schalt10 = Controls.AddTextBox(10,170)' L Controls.SetSize(schalt10,30,20) schalt11 = Controls.AddTextBox(10,200)' M Controls.SetSize(schalt11,30,20) schalt12 = Controls.AddTextBox(10,230)' O Controls.SetSize(schalt12,30,20) schalt13 = Controls.AddTextBox(10,270)' N Controls.SetSize(schalt13,30,20) schalt14 = Controls.AddTextBox(10,300)' Q Controls.SetSize(schalt14,30,20) schalt15 = Controls.AddTextBox(10,330)' A Controls.SetSize(schalt15,30,20) Controls.ButtonClicked = OnButtonClicked ProgammEnde = Controls.AddButton("Programm Ende",250,400) Sub OnButtonClicked button = Controls.LastClickedButton If button = ProgammEnde Then Program.End() EndIf EndSub LDTextWindow.KeyDown = Eingabe Sub Eingabe taste = LDTextWindow.LastKey If taste = "A" Then '' Gleis 1 Controls.SetTextBoxText(schalt1,taste) GraphicsWindow.DrawEllipse(95,65,90,23) Program.Delay(2000) GraphicsWindow.DrawEllipse(110,56,67,93) Controls.SetTextBoxText(schalt1,"") ElseIf taste = "C" Then ''Gleis 2 Controls.SetTextBoxText(schalt6,taste) GraphicsWindow.DrawRectangle(200,120,150,180) Program.Delay(2000) GraphicsWindow.DrawRectangle(230,45,230,120) Controls.SetTextBoxText(schalt6,"") ElseIf taste = "F" Then ''Gleis 4 Controls.SetTextBoxText(schalt7,taste) GraphicsWindow.DrawEllipse(120,65,90,23) Program.Delay(2000) GraphicsWindow.DrawEllipse(110,56,120,93) Controls.SetTextBoxText(schalt7,"") ElseIf taste = "G" Then '' Gleis 5 Controls.SetTextBoxText(schalt8,taste) Controls.SetTextBoxText(schalt8,"") ElseIf taste = "J" Then ''Gleis 6 Controls.SetTextBoxText(schalt9,taste) Controls.SetTextBoxText(schalt9,"") ElseIf taste = "L" Then '' Gleis 5 Links Controls.SetTextBoxText(schalt10,taste) Controls.SetTextBoxText(schalt10,"") ElseIf taste = "M" Then '' Gleis 6 Links Controls.SetTextBoxText(schalt11,taste) Controls.SetTextBoxText(schalt11,"") ElseIf taste = "O" Then '' Gleis 5 Rechts Controls.SetTextBoxText(schalt12,taste) Controls.SetTextBoxText(schalt12,"") ElseIf taste = "N" Then ' Gleis 6 Rechts Controls.SetTextBoxText(schalt13,taste) Controls.SetTextBoxText(schalt13,"") ElseIf taste = "Q" Then ' Gleis 3 vor Einfahrt Controls.SetTextBoxText(schalt14,taste) Controls.SetTextBoxText(schalt14,"") ElseIf taste = "R" Then ' Überhohlgleis Gh Controls.SetTextBoxText(schalt15,taste) Controls.SetTextBoxText(schalt15,"") EndIf If taste = "S" Then ' Gleis aussen vor weiche 9 gesamt5 = Text.Append(Controls.GetTextBoxText(schalt5),taste) Controls.SetTextBoxText(schalt5,gesamt5) anzahlS = Text.GetLength(gesamt5) EndIf If taste = "W" Then ' Gleis aussen nach weich gesamt2 = Text.Append(Controls.GetTextBoxText(schalt2),taste) Controls.SetTextBoxText(schalt2,gesamt2) anzahlW = Text.GetLength(gesamt2) EndIf If taste = "H" Then ' Gleis aussen nmach weiche 11 gesamt3 = Text.Append(Controls.GetTextBoxText(schalt3), taste) Controls.SetTextBoxText(schalt3,gesamt3) anzahlH = Text.GetLength(gesamt3) EndIf If taste = "K" Then ' Gleis gesamt4 = Text.Append(Controls.GetTextBoxText(schalt4), taste) Controls.SetTextBoxText(schalt4, gesamt4) ' taste) anzahlK = Text.GetLength(gesamt4) EndIf If anzahlS = 1 Then EndIf If anzahlS = 2 Then Controls.SetTextBoxText(schalt5,"") EndIf If anzahlK = 1 Then EndIf If anzahlK = 2 Then Controls.SetTextBoxText(schalt4,"") EndIf If anzahlH = 1 Then EndIf If anzahlH = 2 Then 'Gleis 3 fährt nach g 6 über S Controls.SetTextBoxText(schalt3,"") EndIf If anzahlW = 1 Then EndIf If anzahlW = 2 Then 'Gleis 3 fährt nach G 6 über K Controls.SetTextBoxText(schalt2,"") EndIf EndSub End>QJR555.sb< Start>QJR853.sb< cogRadius = 100 cogNumTeeth = 10 cogToothSize = 10 cog = Shapes.AddEllipse(2*cogRadius,2*cogRadius) LDPhysics.AddMovingShape(cog,0.5,0.8,1) For i = 1 To cogNumTeeth angle = (i-1)/cogNumTeeth*2*Math.Pi innerSector = 0.7/cogNumTeeth*2*Math.Pi outerSector = 0.5/cogNumTeeth*2*Math.Pi points[1]["X"] = cogRadius+cogRadius*Math.Cos(angle) points[1]["Y"] = cogRadius+cogRadius*Math.Sin(angle) points[4]["X"] = cogRadius+(cogRadius+cogToothSize)*Math.Cos(angle+innerSector-outerSector) points[4]["Y"] = cogRadius+(cogRadius+cogToothSize)*Math.Sin(angle+innerSector-outerSector) points[3]["X"] = cogRadius+(cogRadius+cogToothSize)*Math.Cos(angle+outerSector) points[3]["Y"] = cogRadius+(cogRadius+cogToothSize)*Math.Sin(angle+outerSector) points[2]["X"] = cogRadius+cogRadius*Math.Cos(angle+innerSector) points[2]["Y"] = cogRadius+cogRadius*Math.Sin(angle+innerSector) tooth = LDShapes.AddPolygon(points) LDPhysics.AddMovingShape(tooth,0.5,0.8,1) LDPhysics.GroupShapes(cog,tooth) EndFor LDPhysics.SetPosition(cog,200,200,0) LDPhysics.SetTorque(cog,100*LDPhysics.GetInertia(cog)) Program.Delay(1000) While ("True") LDPhysics.DoTimestep() Program.Delay(20) EndWhile End>QJR853.sb< Start>QKH042.sb< 'WINDOW GraphicsWindow.Hide() GraphicsWindow.Width = 800 GraphicsWindow.Height = 600 GraphicsWindow.Left = (Desktop.Width - 800) / 2 GraphicsWindow.Top = 50 GraphicsWindow.CanResize = "false" GraphicsWindow.Title = "Converter" 'TRAFFIC_POLICEMAN used = Controls.AddButton(0, 0, 0) Controls.HideControl(used) close_active = Controls.AddButton(0, 0, 0) Controls.HideControl(close_active) calculation = Controls.AddButton(0, 0, 0) Controls.HideControl(calculation) 'COLORS gray25 = GraphicsWindow.GetColorFromRGB(25, 25, 25) gray50 = GraphicsWindow.GetColorFromRGB(50, 50, 50) gray100 = GraphicsWindow.GetColorFromRGB(100, 100, 100) GraphicsWindow.BackgroundColor = gray50 'MAIN_SCREEN GraphicsWindow.BrushColor = gray100 info = Shapes.AddText("") Shapes.Move(info, 5, 580) left_back = Shapes.AddRectangle(250, 30) Shapes.Move(left_back, 125, 215) right_back = Shapes.AddRectangle(250, 30) Shapes.Move(right_back, 425, 215) GraphicsWindow.FontSize = 15 GraphicsWindow.FontBold = "false" GraphicsWindow.BrushColor = "white" left_txt = Shapes.AddText("") Shapes.Move(left_txt, 130, 220) right_txt = Shapes.AddText("") Shapes.Move(right_txt, 430, 220) GraphicsWindow.BrushColor = "lime" to_main = Shapes.AddText("To") Shapes.Move(to_main, 392, 220) GraphicsWindow.BrushColor = "gray" left_screen = Shapes.AddRectangle(250, 100) Shapes.Move(left_screen, 125, 250) right_screen = Shapes.AddRectangle(250, 100) Shapes.Move(right_screen, 425, 250) GraphicsWindow.PenColor = "lime" left_border = Shapes.AddRectangle(226, 75) Shapes.Move(left_border, 137, 263) right_border = Shapes.AddRectangle(226, 75) Shapes.Move(right_border, 437, 263) GraphicsWindow.FontSize = 50 GraphicsWindow.BrushColor = "black" left_tb = Controls.AddTextBox(140, 265) Controls.SetSize(left_tb, 220, 70) right_tb = Controls.AddTextBox(440, 265) Controls.SetSize(right_tb, 220, 70) hidemain() 'MENU GraphicsWindow.PenColor = "lime" GraphicsWindow.BrushColor = gray100 choose = Shapes.AddRectangle(400, 50) Shapes.Move(choose, 200, 80) 'DROP_DOWN GraphicsWindow.PenColor = "black" GraphicsWindow.BrushColor = gray25 drop_back = Shapes.AddRectangle(400, 400) Shapes.Move(drop_back, 200, 155) Shapes.HideShape(drop_back) 'CLOSE close = Shapes.AddRectangle(200, 30) Shapes.Move(close, 300, 562) Shapes.HideShape(close) GraphicsWindow.PenColor = "cyan" close_light = Shapes.AddRectangle(200, 30) Shapes.Move(close_light, 300, 562) Shapes.HideShape(close_light) GraphicsWindow.BrushColor = "white" GraphicsWindow.FontSize = 15 close_txt = Shapes.AddText("Close") Shapes.Move(close_txt, 382, 567) Shapes.HideShape(close_txt) GraphicsWindow.FontName = "consolas" GraphicsWindow.BrushColor = "white" GraphicsWindow.FontBold = "false" GraphicsWindow.FontSize = 25 choose_txt = Shapes.AddText("Convert To") Shapes.Move(choose_txt, 325, 90) 'HIGHLIGHT GraphicsWindow.PenColor = "lime" GraphicsWindow.BrushColor = gray25 light = Shapes.AddRectangle(400, 50) Shapes.Move(light, 200, 155) Shapes.HideShape(light) 'LINES GraphicsWindow.PenColor = "black" line = Shapes.AddLine(200, 205, 600, 205) line2 = Shapes.AddLine(200, 255, 600, 255) line3 = Shapes.AddLine(200, 305, 600, 305) line4 = Shapes.AddLine(200, 355, 600, 355) line5 = Shapes.AddLine(200, 405, 600, 405) line6 = Shapes.AddLine(200, 455, 600, 455) line7 = Shapes.AddLine(200, 505, 600, 505) Shapes.HideShape(line) Shapes.HideShape(line2) Shapes.HideShape(line3) Shapes.HideShape(line4) Shapes.HideShape(line5) Shapes.HideShape(line6) Shapes.HideShape(line7) 'FROM '*'*'*'*' 'FIRST GraphicsWindow.BrushColor = "white" GraphicsWindow.FontSize = 15 metres = Shapes.AddText("Metres") Shapes.Move(metres, 265, 170) Shapes.HideShape(metres) kilometres = Shapes.AddText("Kilometres") Shapes.Move(kilometres, 425, 170) Shapes.HideShape(kilometres) 'SECOND kilometres2 = Shapes.AddText("Kilometres") Shapes.Move(kilometres2, 265, 220) Shapes.HideShape(kilometres2) metres2 = Shapes.AddText("Metres") Shapes.Move(metres2, 425, 220) Shapes.HideShape(metres2) 'THIRD seconds = Shapes.AddText("Seconds") Shapes.Move(seconds, 265, 270) Shapes.HideShape(seconds) hours = Shapes.AddText("Hours") Shapes.Move(hours, 425, 270) Shapes.HideShape(hours) 'FOURTH hours2 = Shapes.AddText("Hours") Shapes.Move(hours2, 265, 320) Shapes.HideShape(hours2) seconds2 = Shapes.AddText("Seconds") Shapes.Move(seconds2, 425, 320) Shapes.HideShape(seconds2) 'FIFTH kilograms = Shapes.AddText("Kilograms") Shapes.Move(kilograms, 265, 370) Shapes.HideShape(kilograms) grams = Shapes.AddText("Grams") Shapes.Move(grams, 425, 370) Shapes.HideShape(grams) 'SIXTH grams2 = Shapes.AddText("Grams") Shapes.Move(grams2, 265, 420) Shapes.HideShape(grams2) kilograms2 = Shapes.AddText("Kilograms") Shapes.Move(kilograms2, 425, 420) Shapes.HideShape(kilograms2) 'SEVENTH mililiters = Shapes.AddText("Mililiters") Shapes.Move(mililiters, 265, 470) Shapes.HideShape(mililiters) liters = Shapes.AddText("Liters") Shapes.Move(liters, 425, 470) Shapes.HideShape(liters) 'EIGHTH liters2 = Shapes.AddText("Liters") Shapes.Move(liters2, 265, 520) Shapes.HideShape(liters2) mililiters2 = Shapes.AddText("Mililiters") Shapes.Move(mililiters2, 425, 520) Shapes.HideShape(mililiters2) 'TO GraphicsWindow.BrushColor = "lime" to_ = Shapes.AddText("To") Shapes.Move(to_, 375, 170) Shapes.HideShape(to_) to_2 = Shapes.AddText("To") Shapes.Move(to_2, 375, 220) Shapes.HideShape(to_2) to_3 = Shapes.AddText("To") Shapes.Move(to_3, 375, 270) Shapes.HideShape(to_3) to_4 = Shapes.AddText("To") Shapes.Move(to_4, 375, 320) Shapes.HideShape(to_4) to_5 = Shapes.AddText("To") Shapes.Move(to_5, 375, 370) Shapes.HideShape(to_5) to_6 = Shapes.AddText("To") Shapes.Move(to_6, 375, 420) Shapes.HideShape(to_6) to_7 = Shapes.AddText("To") Shapes.Move(to_7, 375, 470) Shapes.HideShape(to_7) to_8 = Shapes.AddText("To") Shapes.Move(to_8, 375, 520) Shapes.HideShape(to_8) 'SUBROUTINES '*'*'*'*'*'*'*'*'*'*' 'MOUSE_DOWN GraphicsWindow.MouseDown = click Sub click x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY 'CLICK_MENU If x > 200 And x < 600 And y > 80 And y < 130 Then hidemain() Sound.PlayClick() Shapes.ShowShape(drop_back) Shapes.ShowShape(line) Shapes.ShowShape(line2) Shapes.ShowShape(line3) Shapes.ShowShape(line4) Shapes.ShowShape(line5) Shapes.ShowShape(line6) Shapes.ShowShape(line7) Shapes.ShowShape(close) Shapes.ShowShape(close_txt) Shapes.ShowShape(to_) Shapes.ShowShape(to_2) Shapes.ShowShape(to_3) Shapes.ShowShape(to_4) Shapes.ShowShape(to_5) Shapes.ShowShape(to_6) Shapes.ShowShape(to_7) Shapes.ShowShape(to_8) Shapes.ShowShape(metres) Shapes.ShowShape(kilometres) Shapes.ShowShape(metres2) Shapes.ShowShape(kilometres2) Shapes.ShowShape(seconds) Shapes.ShowShape(hours) Shapes.ShowShape(seconds2) Shapes.ShowShape(hours2) Shapes.ShowShape(kilograms) Shapes.ShowShape(grams) Shapes.ShowShape(kilograms2) Shapes.ShowShape(grams2) Shapes.ShowShape(mililiters) Shapes.ShowShape(liters) Shapes.ShowShape(mililiters2) Shapes.ShowShape(liters2) Shapes.ShowShape(light) Controls.SetButtonCaption(close_active, 1) EndIf 'CLICK_CLOSE get_close_active = Controls.GetButtonCaption(close_active) If get_close_active = 1 Then If x > 300 And x < 500 And y > 562 And y < 592 Then hidemenu() get_used = Controls.GetButtonCaption(used) If get_used = 1 Then showmain() EndIf EndIf 'CLICK_FIRST If x > 200 And x < 600 And y > 155 And y < 205 Then hidemenu() Shapes.SetText(left_txt, "Metres") Shapes.SetText(right_txt, "Kilometres") Shapes.SetText(info, "1000 metres are 1 kilometre") Controls.SetButtonCaption(calculation, 1) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_SECOND If x > 200 And x < 600 And y > 205 And y < 255 Then hidemenu() Shapes.SetText(left_txt, "Kilometres") Shapes.SetText(right_txt, "Metres") Shapes.SetText(info, "1 kilometre is 1000 metres") controls.SetButtonCaption(calculation, 2) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_THIRD If x > 200 And x < 600 And y > 255 And y < 305 Then hidemenu() Shapes.SetText(left_txt, "Seconds") Shapes.SetText(right_txt, "Hours") Shapes.SetText(info, "3600 seconds are 1 hour") Controls.SetButtonCaption(calculation, 3) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_FOURTH If x > 200 And x < 600 And y > 305 And y < 355 Then hidemenu() Shapes.SetText(left_txt, "Hours") Shapes.SetText(right_txt, "Seconds") Shapes.SetText(info, "1 hour is 3600 seconds") Controls.SetButtonCaption(calculation, 4) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_FIFTH If x > 200 And x < 600 And y > 355 And y < 405 Then hidemenu() Shapes.SetText(left_txt, "Kilograms") Shapes.SetText(right_txt, "Grams") Shapes.SetText(info, "1 kilogram is 1000 grams") Controls.SetButtonCaption(calculation, 5) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_SIXTH If x > 200 And x < 600 And y > 405 And y < 455 Then hidemenu() Shapes.SetText(left_txt, "Grams") Shapes.SetText(right_txt, "Kilograms") Shapes.SetText(info, "1000 grams are 1 kilogram") Controls.SetButtonCaption(calculation, 6) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_SEVENTH If x > 200 And x < 600 And y > 455 And y < 505 Then hidemenu() Shapes.SetText(left_txt, "Mililiters") Shapes.SetText(right_txt, "Liters") Shapes.SetText(info, "1000 mililitres are 1 litre") Controls.SetButtonCaption(calculation, 7) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf 'CLICK_EIGHT If x > 200 And x < 600 And y > 505 And y < 555 Then hidemenu() Shapes.SetText(left_txt, "Liters") Shapes.SetText(right_txt, "Mililiters") Shapes.SetText(info, "1 litre is 1000 mililitres") Controls.SetButtonCaption(calculation, 8) Controls.SetButtonCaption(used, 1) cls() showmain() EndIf EndIf EndSub 'MOUSE_MOVE GraphicsWindow.MouseMove = mm Sub mm x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY 'MOVE_LIGHT If get_close_active = 1 Then If x > 200 And x < 600 And y > 155 And y < 205 Then Shapes.Move(light, 200, 155) EndIf If x > 200 And x < 600 And y > 205 And y < 255 Then Shapes.Move(light, 200, 205) EndIf If x > 200 And x < 600 And y > 255 And y < 305 Then Shapes.Move(light, 200, 255) EndIf If x > 200 And x < 600 And y > 305 And y < 355 Then Shapes.Move(light, 200, 305) EndIf If x > 200 And x < 600 And y > 355 And y < 405 Then Shapes.Move(light, 200, 355) EndIf If x > 200 And x < 600 And y > 405 And y < 455 Then Shapes.Move(light, 200, 405) EndIf If x > 200 And x < 600 And y > 455 And y < 505 Then Shapes.Move(light, 200, 455) EndIf If x > 200 And x < 600 And y > 505 And y < 555 Then Shapes.Move(light, 200, 505) EndIf EndIf EndSub 'TEXT_TYPED Controls.TextTyped = tt Sub tt get_calculation = Controls.GetButtonCaption(calculation) get_left_tb = Controls.GetTextBoxText(left_tb) If get_calculation = 1 Or get_calculation = 6 Or get_calculation = 7 Then Controls.SetTextBoxText(right_tb, get_left_tb / 1000) EndIf If get_calculation = 2 Or get_calculation = 5 Or get_calculation = 8 Then Controls.SetTextBoxText(right_tb, get_left_tb * 1000) EndIf If get_calculation = 3 Then Controls.SetTextBoxText(right_tb, get_left_tb / 3600) EndIf If get_calculation = 4 Then Controls.SetTextBoxText(right_tb, get_left_tb * 3600) EndIf EndSub 'MY_SUBROUTINES '*'*'*'*'*'*'*'*'*'*'*'*'*'* 'HIDE_MAIN Sub hidemain Shapes.HideShape(left_back) Shapes.HideShape(right_back) Shapes.HideShape(left_txt) Shapes.HideShape(right_txt) Shapes.HideShape(left_border) Shapes.HideShape(right_border) Shapes.HideShape(left_screen) Shapes.HideShape(right_screen) Shapes.HideShape(to_main) Shapes.HideShape(info) Controls.HideControl(left_tb) Controls.HideControl(right_tb) EndSub 'SHOW_MAIN Sub showmain Shapes.ShowShape(left_back) Shapes.ShowShape(right_back) Shapes.ShowShape(left_txt) Shapes.ShowShape(right_txt) Shapes.ShowShape(left_border) Shapes.ShowShape(right_border) Shapes.ShowShape(left_screen) Shapes.ShowShape(right_screen) Shapes.ShowShape(to_main) Shapes.ShowShape(info) Controls.ShowControl(left_tb) Controls.ShowControl(right_tb) EndSub 'HIDE_MENU sub hidemenu Sound.PlayClick() Shapes.HideShape(light) Shapes.HideShape(line) Shapes.HideShape(line2) Shapes.HideShape(line3) Shapes.HideShape(line4) Shapes.HideShape(line5) Shapes.HideShape(line6) Shapes.HideShape(line7) Shapes.HideShape(close) Shapes.HideShape(close_txt) Shapes.HideShape(drop_back) Shapes.HideShape(to_) Shapes.HideShape(to_2) Shapes.HideShape(to_3) Shapes.HideShape(to_4) Shapes.HideShape(to_5) Shapes.HideShape(to_6) Shapes.HideShape(to_7) Shapes.HideShape(to_8) Shapes.HideShape(metres) Shapes.HideShape(kilometres) Shapes.HideShape(kilometres2) Shapes.HideShape(metres2) Shapes.HideShape(seconds) Shapes.HideShape(hours) Shapes.HideShape(seconds2) Shapes.HideShape(hours2) Shapes.HideShape(kilograms) Shapes.HideShape(grams) Shapes.HideShape(kilograms2) Shapes.HideShape(grams2) Shapes.HideShape(mililiters) Shapes.HideShape(liters) Shapes.HideShape(mililiters2) Shapes.HideShape(liters2) Shapes.HideShape(light) Controls.SetButtonCaption(close_active, 0) EndSub 'CLS Sub cls Controls.SetTextBoxText(left_tb, "") Controls.SetTextBoxText(right_tb, "") EndSub 'SHOW_WINDOW GraphicsWindow.Show() End>QKH042.sb< Start>QKM941.sb< imm= "afg;000009352.jpg aus;000009001.gif cro;000010418.gif cyp;000010379.gif fin;000010715.gif gre;000010395.gif ice;000010136.gif isr;000009415.gif kaz;000010348.gif kos;000010449.gif mld;000011417.gif mzb;000008849.gif imm=imm+" grn;000009738.gif gmb;000008295.gif gtm;000009718.gif mdg;000008805.gif jam;000009684.gif mrs;000009217.gif nzl;000009173.gif pak;000011223.gif per;000010056.gif sin;000011109.gif svg;000009726.gif spn;000010470.gif usa;000007302.gif uae;000009289.gif vnz;000009997.gif urg;000009640.gif sey;000008499.gif tkm;000010634.gif slk;000011147.gif thl;000011170.gif imm=imm+" ids;000011057.gif pol;000010783.gif ttb;000009801.gif scn;000009733.gif stp;000008410.gif png;000009211.gif qat;000009367.gif mex;000010051.gif mlw;000008828.gif imm=imm+" alb;000010196.gif but;000011346.gif bru;000011292.gif chn;000010767.gif chl;000009808.gif csr;000009759.gif ecd;000009625.gif geo;000010429.gif den;000010575.gif ind;000011037.gif fmc;000010860.gif mne;000010907.jpg mic;000009242.gif mng;000011431.gif nep;000011196.gif imm=imm+" ukk;000010295.gif nor;000010661.gif swe;000010512.gif ser;000010622.gif pan;000009880.gif mlt;000010865.gif swi;000010484.gif vat;000010646.gif por;000010828.gif lat;000010919.gif est;000010339.gif slk;000010553.gif slv;000010569.gif czk;000010539.gif snm;000010463.gif and;000010155.gif im=ldtext.Split (imm " ") im1= "xxx;000010175.gif xxx;000010845.gif xxx;000010810.gif xxx;000010930.gif xxx;000010895.gif xxx;000010886.gif xxx;000010231.gif xxx;000010266.gif xxx;000010526.gif xxx;000008300.gif xxx;000008799.gif xxx;000008476.gif xxx;000008642.gif xxx;000008668.gif xxx;000008542.gif xxx;000008786.gif xxx;000008589.gif xxx;000008404.gif xxx;000008376.gif xxx;000008773.gif xxx;000008335.gif im1=im1+" bra;000009959.gif bol;000010084.gif blz;000009953.gif bbd;000009916.gif cub;000009700.gif bhr;000009554.gif bhm;000009894.gif dmr;000009847.gif esl;000009658.gif roc;000011183.gif mls;000011384.gif lst;000008948.gif prg;000009926.gif phl;000011322.gif sng;000008571.gif tky;000009513.gif syr;000009485.gif rwa;000008913.gif slm;000009110.gif im1=im1+" sur;000009709.gif sam;000009094.gif tng;000009141.gif vnm;000011315.gif nau;000009159.gif nmb;000008720.gif lby;000008940.gif mor;000008916.gif mrt;000008882.gif im1=im1+" dmk;000009832.gif ert;000008199.gif guy;000009682.gif fji;000009191.gif eth;000008282.gif jrd;000009501.gif irq;000009462.gif irn;000009283.gif hnd;000010024.gif hai;000009849.gif alg;000008105.gif arg;000009594.gif clb;000009780.gif cbd;000011077.gif imi=ldtext.Split (im1 " ") stt="Afganistan;Australia;Croatia;Cyprus;Finland;Greece;Iceland;Israel;Kazakhistan;Kosovo;Maldives;Mozambique;Grenada;Gambia;Guatemala; stt=stt+"Madagascar;Jamaica;Marshall;New Zealand;Pakistan;Peru;Singapore;Saint Vincent and the Grenadines;Spain;USA;UAE;Venezuela;Urugvay; stt=stt+"Seychelles;Turkmenistan;Sri Lanka;Thailand;Indonesia;Poland;Trinidad&Tobago;St Christopher&Nevis;Sao Tome&Principe;Papua New Guinea; stt=stt+"Qatar;Mexico;Malawi;Albania;Bhutan;Brunei;China;Chile;Costa Rica;Ecuador;Georgia;Denmark;India;FYR Macedonia;Montenegro;Micronesia;Mongolia;Nepal; stt=stt+"UK;Norway;Sweden;Serbia;Panama;Malta;Switzerland;Vatican;Portugal;Latvia;Estonia;Slovakia;Slovenia;Chech Rep.;San Marino;Andorra; stt=stt+"Austria;Belgium;France;Germany;Hungary;Italy;The Netherlands;Japan;Bangladesh;Palau;Luxembourg;Romania;Bulgaria;Ireland;Lithuania;Ivory Coast; stt=stt+"Nigeria;Armenia;Russia;Gabon;Sierra Leone;Yemen;Niger;Mali;Guinea;Azerbaijan;Belarus;B&H;Liechtenstein;Moldova;Monaco;Ucraine;Uzbekistan;Tajikistan;Egypt;Benin;Djibouti;Togo;Tanzania;Sudan;Burundi;CAR;DR Kongo;R.of Kongo;Botswana;Comoros; stt=stt+"Brazil;Bolivia;Belize;Barbados;Cuba;Bahrain;Bahamas;Dominican Rep.;El Salvador;Rep.of Korea;Malaysia;Lesotho;Paraguay;Philippines;Senegal;Turkey;Syria;Rwanda;Solomon;Suriname;Samoa;Tonga;Viet Nam;Nauru;Namibia;Libya;Morocco;Mauritius;Dominica;Eritrea;Guyana;Fiji;Ethiopia;Jordan; stt=stt+"Iraq;Iran;Honduras;Haiti;Algeria;Argentina;Colombia;Cambodia cnt=ldtext.Split (stt ";") TextWindow.WriteLine (cnt) eu=ldtext.Split ("83 84 85 86 87 3 4 5 6 73 74 75 76 77 78 79 65 66 67 68 69 70 57 59 62 24 34 50" " ") 'TLF895 GraphicsWindow.Title="World of Flags br="1=blue;2=midnightblue;3=black LDGraphicsWindow.BackgroundBrush (LDShapes.BrushGradient (br "DD")) GraphicsWindow.Width=900 GraphicsWindow.Height =850 sf=Array.GetItemCount (im) sf1=Array.GetItemCount (imi) mf=sf fw=112 fh=75 bw=fw/3 lh=fh/3 itt=ldtext.Split ("All;EU;Europe;Asia;Africa;S.America;Islands" ";") LDDialogs.AddRightClickMenu (itt "") LDDialogs.RightClickMenu =rmm For i=1 To sf ii=ImageList.LoadImage ("http://www.mofa.go.jp/files/"+Text.GetSubTextToEnd (im[i] 5)) ss[i]=Shapes.AddImage (ii ) Shapes.Zoom (ss[i] .8 .8) LDEffect.DropShadow (ss[i] "color=skyblue") Shapes.Move (ss[i] math.Remainder (i-1 8)*95+50 55+Math.Floor ((i-1)/8)*65) if i=56 Then Shapes.Move(ss[i] math.Remainder (i-1 8)*95+90 55+Math.Floor ((i-1)/8)*65) endif LDDialogs.ToolTip (ss[i] cnt[i]) LDShapes.AnimateRotation (ss[i] 1555 4) Program.Delay (55) EndFor LDShapes.AnimateZoom (ss[sf] 750 0 1.3 1.3) LDEvents.MouseWheel=mww GraphicsWindow.KeyDown=kkk mm=1000 zz=1 cr=9 args=0 LDCall.Function4("hflg" "white" "red" "red" 1) LDCall.Function4("vflg" "yellow" "black" "red" 2) LDCall.Function4("vflg" "white" "blue" "red" 3) LDCall.Function4("hflg" "red" "black" "yellow" 4) LDCall.Function4("hflg" "white" "red" "green" 5) LDCall.Function4("vflg" "white" "green" "red" 6) LDCall.Function4("hflg" "white" "red" "blue" 7) LDCall.Function4("vflg" "white" "c" "red" 8) cr=10 dd=-10 LDCall.Function4("vflg" "green" "c" "red" 1) LDCall.Function4("vflg" "lightblue" "c" "yellow" 2) LDCall.Function4("hflg" "white" "red" "lightblue" 3) LDCall.Function4("vflg" "yellow" "blue" "red" 4) LDCall.Function4("hflg" "green" "white" "red" 5) LDCall.Function4("vflg" "white" "green" "orange" 6) LDCall.Function4("hflg" "green" "yellow" "red" 7) LDCall.Function4("vflg" "white" "orange" "green" 8) cr=11 cyn= LDColours.HSLtoRGB (210 1 .55) LDCall.Function4("vflg" "white" "darkgreen" "darkgreen" 1) LDCall.Function4("hflg" "blue" "red" "Orange" 2) LDCall.Function4("hflg" "blue" "white" "red" 3) LDCall.Function4("hflg" "yellow" "green" cyn 4) LDCall.Function4("hflg" "white" "green" cyn 5) LDCall.Function4("hflg" "white" "red" "black" 6) LDCall.Function4("hflg" "white" "orange" "darkgreen" 7) LDCall.Function4("vflg" "yellow" "darkgreen" "red" 8) dx=36 LDCall.Function4("vflg" "yellow" "red" "darkgreen" 10) For j=1 To sf1 ii=ImageList.LoadImage ("http://www.mofa.go.jp/files/"+Text.GetSubTextToEnd (imi[j] 5)) ss[i]=Shapes.AddImage (ii ) Shapes.Zoom (ss[i] .8 .8) LDEffect.DropShadow (ss[i] "color=skyblue") Shapes.Move (ss[i] math.Remainder (j-1 8)*95+870 55+Math.Floor ((j-1)/8)*65) LDDialogs.ToolTip (ss[i] cnt[i]) LDShapes.AnimateRotation (ss[i] 1555 4) Program.Delay (55) i=i+1 mf=i-1 EndFor Sub rmm di=LDDialogs.LastRightClickMenuItem If di=1 Then For x=1 to mf Shapes.ShowShape (ss[x]) EndFor ElseIf di=2 then For x=1 to mf If Array.ContainsValue (eu x) then Shapes.ShowShape (ss[x]) Else Shapes.hideShape (ss[x]) EndIf EndFor EndIf EndSub Sub hflg gg=FCDrawings.CreateGraphics(fw fh) FCDrawings.FillRectangle (gg args[1] 0 0 fw fh) FCDrawings.FillRectangle (gg args[2] 0 0 fw lh) FCDrawings.FillRectangle (gg args[3] 0 lh*2 fw lh) If i=95 Then FCDrawings.FillEllipse(gg "orange" fw/2-10 fh/2-10 20 20) endif im=FCDrawings.GenerateImage(gg) s0=Shapes.AddImage (im ) Shapes.Zoom (s0 .8 .8) shapes.Move (s0 50+95*(args[4]-1) 55+cr*65) LDEffect.DropShadow (s0 "color=skyblue") ss[i]=s0 LDDialogs.ToolTip (ss[i] cnt[i]) LDShapes.AnimateRotation (ss[i] 1555 4) Program.Delay (55) mf=mf+1 i=i+1 EndSub Sub vflg gg=FCDrawings.CreateGraphics(fw fh) FCDrawings.FillRectangle (gg args[1] 0 0 fw fh) If args[2]="c" Then FCDrawings.FillEllipse (gg args[3] bw+dd lh-5 bw bw) else FCDrawings.FillRectangle (gg args[2] 0 0 bw fh) FCDrawings.FillRectangle (gg args[3] bw*2 0 bw fh) EndIf im=FCDrawings.GenerateImage(gg) s0=Shapes.AddImage (im ) Shapes.Zoom (s0 .8 .8) shapes.Move (s0 50+95*(args[4]-1)-dx 55+cr*65) LDEffect.DropShadow (s0 "color=skyblue") ss[i]=s0 LDDialogs.ToolTip (ss[i] cnt[i]) LDShapes.AnimateRotation (ss[i] 1555 4) Program.Delay (55) i=i+1 mf=mf+1 EndSub Sub mww If Mouse.IsRightButtonDown Then aa=aa+ LDEvents.LastMouseWheelDelta *3 Else zz=zz+ LDEvents.LastMouseWheelDelta/15 EndIf ldGraphicsWindow.Reposition (zz zz xx yy aa) EndSub Sub kkk LDShapes.AnimateZoom (ss[sf] 0 0 0 0) Shapes.Zoom(ss[sf] .8 .8) ls=text.ConvertToLowerCase (GraphicsWindow.LastKey) If ls="space" Then sf=sf+1 ElseIf ls="back" then sf=sf-1 ElseIf ls="left" then xx=xx-5 ElseIf ls="right" then xx=xx+5 ElseIf ls="up" then yy=yy-5 ElseIf ls="down" then yy=yy+5 EndIf If sf<1 Then sf=mf ElseIf sf>mf then sf=1 EndIf GraphicsWindow.Title="State of "+cnt[sf] mm=mm+1 LDShapes.ZIndex (ss[sf] mm) LDShapes.AnimateZoom (ss[sf] 750 0 1.3 1.3) ldGraphicsWindow.Reposition (zz zz xx yy aa) EndSub End>QKM941.sb< Start>QKN903.sb< ' Lowres graphics in textwindow ' Too bad no user key input ability... TextWindow.BackgroundColor = "white" TextWindow.ForegroundColor = "black" For i = 1 To 600 ' Appears to have 23 rows, 78 columns TextWindow.CursorTop = Math.GetRandomNumber(23) TextWindow.CursorLeft = Math.GetRandomNumber(78) TextWindow.WriteLine(" ") EndFor While 1=1 EndWhile End>QKN903.sb< Start>QKQ121-1.sb< '################################################ 'MAIN PROGRAM 'THE RUNNING TOTAL IS HELD IN VARIABLE 'balance' '################################################ Introduction() LoadBalance() 'Continue until we are finished While ("True") ShowBalance() TextWindow.WriteLine("Are we going to subtract, add, or are we done (a/s/d)") answer = Text.ConvertToLowerCase(TextWindow.Read()) ' convert to lower case to accept A or a or S or s or D or d If (answer = "a") Then Add() ElseIf(answer = "s") Then Subtract() ElseIf(answer = "d") Then Confirmation() EndIf EndWhile '################################################ 'SUBROUTINES '################################################ 'Openning introduction Sub Introduction TextWindow.WriteLine("Welcome to BalanceMeNow!") TextWindow.WriteLine("This program balances your checkbook for you!") Program.Delay(2000) TextWindow.Clear() TextWindow.WriteLine("Loading...") Program.Delay(2000) EndSub 'Get the initial balance Sub LoadBalance TextWindow.Clear() TextWindow.WriteLine("Please enter your current balance: ") balance = TextWindow.ReadNumber() 'Read a number Program.Delay(2000) EndSub 'Make a deposit Sub Add TextWindow.Clear() TextWindow.WriteLine("Welcome to the adding section of BalanceMeNow") TextWindow.WriteLine("This will add deposits to your bank account") Program.Delay(4000) TextWindow.Clear() TextWindow.WriteLine("Please input the deposit amount: ") deposit = TextWindow.ReadNumber() 'Read a number balance = balance + deposit ShowBalance() EndSub 'Make a withdrawal Sub Subtract TextWindow.Clear() TextWindow.WriteLine("Welcome to the subtracting part of BalanceMeNow!") TextWindow.WriteLine("This will subtract debits from your bank account") Program.Delay(4000) TextWindow.Clear() TextWindow.WriteLine("Please input the debit amount: ") debit = TextWindow.ReadNumber() 'Read a number balance = balance - debit ShowBalance() EndSub 'Display the current balance Sub ShowBalance RoundBalance() TextWindow.Clear() TextWindow.Write("Your subtotal is: ") If (balance < 0) Then TextWindow.ForegroundColor = "Red" Else TextWindow.ForegroundColor = "Green" EndIf TextWindow.WriteLine(balance) TextWindow.ForegroundColor = "White" Program.Delay(2000) EndSub 'Round balance to nearest cent Sub RoundBalance balance = 0.01*Math.Floor(100*balance + 0.5) 'Round to nearest cent EndSub 'Confirmation to quit Sub Confirmation ShowBalance() TextWindow.Clear() TextWindow.WriteLine("Are you ready to end the program (y/n): ") answer = Text.ConvertToLowerCase(TextWindow.Read()) If (answer = "y")Then Finished() EndIf EndSub 'Ending procedure on final quit Sub Finished For i = 10 To 1 Step -1 TextWindow.Clear() TextWindow.WriteLine("Closing program in "+i) Program.Delay(1000) EndFor TextWindow.Clear() TextWindow.WriteLine("Closing....") Program.Delay(3000) Program.End() EndSub End>QKQ121-1.sb< Start>QKQ121.sb< TextWindow.WriteLine("Welcome to BalanceMeNow!") TextWindow.WriteLine("This program balances your checkbook for you!") Program.Delay(4000) TextWindow.Clear() TextWindow.WriteLine("Loading...") Program.Delay(4000) TextWindow.Clear() TextWindow.WriteLine("Please enter your current balance: ") balance = TextWindow.Read() Program.Delay(4000) TextWindow.Clear() startataddorsub: TextWindow.WriteLine("Now that we have that, we will be subtracting first.") Program.Delay(1000) TextWindow.Clear() Program.Delay(2000) TextWindow.Clear() Goto subtract add: TextWindow.WriteLine("Welcome to the adding section of BalanceMeNow") TextWindow.WriteLine("This will add deposits to your bank account") Program.Delay(4000) TextWindow.Clear() TextWindow.WriteLine("Please input the deposit amount: ") deposit = TextWindow.Read() added = deposit + balance Program.Delay(3000) TextWindow.Clear() total = num1 + deposit TextWindow.WriteLine("Your subtotal is: "+total) TextWindow.WriteLine("Add another or are we done (a/d)") nextstep: choice2 = TextWindow.Read() choosemenao: If (choice2 = "a")Then Goto add Else Goto choice2option2 EndIf choice2option2: If (choice2 = "d")Then Goto done Else Goto choosemenao EndIf begin: Goto done done: absolute = total TextWindow.WriteLine("Your total is: "+absolute) TextWindow.WriteLine("Are you ready to end the program (y/n): ") endprogram = TextWindow.Read() If (endprogram = "y")Then Goto end Else Goto begin EndIf end: TextWindow.WriteLine("Closing program in 10") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 9") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 8") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 7") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 6") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 5") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 4") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 3") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 2") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing program in 1") Program.Delay(1000) TextWindow.Clear() TextWindow.WriteLine("Closing....") Program.Delay(3000) Program.End() subtract: TextWindow.WriteLine("Welcome to the subtracting part of BalanceMeNow!") TextWindow.WriteLine("This will subtract debits from your bank account") Program.Delay(5000) TextWindow.Clear() TextWindow.WriteLine("Please input the debit amount: ") debitamount = TextWindow.Read() subtract = debitamount - balance Program.Delay(3000) TextWindow.Clear() num1 = balance - debitamount TextWindow.WriteLine("Your subtotal is: "+num1) TextWindow.WriteLine("Are we going to subtract more, add, or are we done (a/s/d)") moretotract = TextWindow.Read() startatsub: If (moretotract = "s")Then Goto subtract Else Goto choicetwooption2 EndIf choicetwooption2: If (choice2 = "a")Then Goto add Else Goto choicetwooption3 EndIf choicetwooption3: If (choice2 = "d")Then Goto done Else Goto startatsub EndIf End>QKQ121.sb< Start>QKQ309.sb< 'set up array month[1] = "January" month[2] = "February" month[3] = "March" month[4] = "April" month[5] = "May" month[6] = "June" month[7] = "July" month[8] = "August" month[9] = "September" month[10] = "October" month[11] = "November" month[12] = "December" 'set up screen GraphicsWindow.Width =800 GraphicsWindow.height =550 GraphicsWindow.Top = 50 GraphicsWindow.Title=("Horoscopes by SkidMarcUK") GraphicsWindow.CanResize="no" GraphicsWindow.Show() for loop=0 To 255 GraphicsWindow.PenWidth=3 GraphicsWindow.PenColor=GraphicsWindow.GetColorFromRGB(loop,0,200) GraphicsWindow.Drawline(0,loop*2.5,800,loop*2.5) endfor 'GraphicsWindow.BackgroundColor="indigo" GraphicsWindow.BrushColor = "black" GraphicsWindow.penColor = "white" 'set up title Controls.ButtonClicked= chkbut 'GraphicsWindow.Clear() GraphicsWindow.FontSize = 90 GraphicsWindow.DrawText(170,5,"Horoscope") GraphicsWindow.BrushColor = "mediumorchid" GraphicsWindow.DrawText(160,0,"Horoscope") GraphicsWindow.DrawRectangle( 50,120,700,300) GraphicsWindow.BrushColor = "black" GraphicsWindow.FillRectangle( 50,120,700,300) GraphicsWindow.FontSize=50 Controls.AddButton("Month",50,450) Controls.SetSize("Button1",350,75) Controls.AddButton("Date",430,450) Controls.SetSize("Button2",170,75) Controls.AddButton("GO",630,450) Controls.SetSize("Button3",120,75) rem=-20 stars() start: scroll() Goto start Sub stars For loop=10 to 100 ax[loop]=Math.GetRandomNumber(670)+65 ay[loop]=Math.GetRandomNumber(292)+120 lum=loop shapes.SetOpacity(dot[loop],lum) dot[loop]= shapes.addEllipse(5,5) shapes.SetOpacity(dot[loop],lum) shapes.Move(dot[loop],ax[loop],ay[loop]) endfor EndSub sub scroll nsa=nsa+1 For loop2= 10 To 40 shapes.Move(dot[loop2],ax[loop2]-nsa,ay[loop2]) If ax[loop2]-nsa< 50 Then ax[loop2]=ax[loop2]+699 endif endfor nsb=nsb+2 For loop3= 41 To 70 shapes.Move(dot[loop3],ax[loop3]-nsb,ay[loop3]) If ax[loop3]-nsb< 50 Then ax[loop3]=ax[loop3]+699 endif endfor nsc=nsc+3 For loop4= 71 To 100 shapes.Move(dot[loop4],ax[loop4]-nsc,ay[loop4]) If ax[loop4]-nsc< 50 Then ax[loop4]=ax[loop4]+699 endif endfor endsub Sub chkbut but=Controls.LastClickedButton Sound.PlayClick() if but="Button1" then button1() endif if but="Button2" then button2() endif if but="Button3" then button3() endif endsub sub button1 If m=12 then m=0 endif m=m + 1 Controls.SetButtonCaption(but,month[m]) endsub sub button2 If n=31 then n=0 endif n=n + 1 Controls.SetButtonCaption(but,n) endsub sub button3 character = Text.GetCharacter(10) GraphicsWindow.penColor="white" GraphicsWindow.brushColor = "black" GraphicsWindow.FillRectangle( 50,120,700,300) GraphicsWindow.brushColor = "mediumorchid" GraphicsWindow.FontSize =18 'jan If m=1 And n<21 then Capricorn() endif If m=1 and n>20 then Aquarius() endif 'feb If m=2 And n<20 then Aquarius() endif If m=2 and n>19 then Pisces() endif 'march If m=3 And n<21 then Pisces() endif If m=3 and n>20 then Aries() endif 'april If m=4 And n<21 then Aries() endif If m=4 and n>20 then Taurus() endif 'may If m=5 And n<22 then Taurus() endif If m=5 and n>21 then Gemini() endif 'june If m=6 And n<22 then Gemini() endif If m=6 and n>21 then Cancer() endif 'july If m=7 And n<23 then Cancer() endif If m=7 and n>22 then Leo() endif 'august If m=8 And n<23 then Leo() endif If m=8 and n>22 then Virgo() endif 'september If m=9 And n<24 then Virgo() endif If m=9 and n>23 then Libra() endif 'october If m=10 And n<24 then Libra() endif If m=10 and n>23 then Scorpio() endif 'november If m=11 And n<23 then Scorpio() endif If m=11 and n>22 then Sagittarius() endif 'december If m=12 And n<22 then Sagittarius() endif If m=12 and n>21 then Capricorn() endif endsub sub Capricorn GraphicsWindow.DrawBoundText(270,125,470"Capricorn - The Goat" + character + "December 22 to January 20" + character + "" +character + "Traditional Capricorn Traits" + character + "Practical and prudent" + character + "Ambitious and disciplined" + character + "Patient and careful" + character + "Humorous and reserved" + character + "" +character + "On the dark side...." + character + "Pessimistic and fatalistic" + character + "Miserly and grudging" + character + "Over conventional and rigid") endsub sub Aquarius GraphicsWindow.DrawBoundText(270,125,470,"Aquarius - The Water Carrier" + character + "January 21 to February 19" + character + "" +character + "Traditional Aquarian Traits" + character + "Friendly and humanitarian" + character + "Honest and loyal" + character + "Original and inventive" + character + "Independent and intellectual" + character + "" +character + "On the dark side...." + character + "Intractable and contrary" + character + "Perverse and unpredictable" + character + "Unemotional and detached") endsub sub Pisces GraphicsWindow.DrawBoundText(270,125,470,"Pisces - The Fishes" + character + "Febuary 20 to March 20" + character + "" +character + "Traditional Pisces Traits" + character + "Imaginative and sensitive" + character + "Compassionate and kind" + character + "Selfless and unworldly" + character + "Intuitive and sympathetic" + character + "" +character + "On the dark side...." + character + "Escapist and idealistic" + character + "Secretive and vague" + character + "Weak-willed and easily led") endsub sub Aries GraphicsWindow.DrawBoundText(270,125,470,"Aries - The Ram" + character + "March 21 to April 20" + character + "" +character + "Traditional Aries Traits" + character + "Adventurous and energetic" + character + "Pioneering and courageous" + character + "Enthusiastic and confident" + character + "Dynamic and quick-witted" + character + "" +character + "On the dark side..." + character + "Selfish and quick-tempered" + character + "Impulsive and impatient" + character + "Foolhardy and daredevil") endsub sub Taurus GraphicsWindow.DrawBoundText(270,125,470"Taurus - The Bull" + character + "April 21 to May 21" + character + "" +character + "Traditional Taurus Traits" + character + "Patient and reliable" + character + "Warmhearted and loving" + character + "Persistent and determined" + character + "Placid and security loving" + character + "" +character + "On the dark side...." + character + "Jealous and possessive" + character + "Resentful and inflexible" + character + "Self-indulgent and greedy") endsub sub Gemini GraphicsWindow.DrawBoundText(270,125,470,"Gemini - The Twins" + character + "Gemini May 22 to June 21" + character + "" +character + "Traditional Gemini traits" + character + "Adaptable and versatile" + character + "Communicative and witty" + character + "Intellectual and eloquent" + character + "Youthful and lively" + character + "" +character + "On the dark side...." + character + "Nervous and tense"+ character + "Superficial and inconsistent" + character + "Cunning and inquisitive") endsub sub Cancer GraphicsWindow.DrawBoundText(270,125,470,"Cancer - The Crab" + character + "June 22 to July 22" + character + "" +character + "Traditional Cancer Traits" + character + "Emotional and loving" + character + "Intuitive and imaginative" + character + "Shrewd and cautious" + character + "Protective and sympathetic" + character + "" +character + "On the dark side...." + character + "Changeable and moody" + character + "Overemotional and touchy" + character + "Clinging and unable to let go") endsub sub Leo GraphicsWindow.DrawBoundText(270,125,470,"Leo - The Lion" + character + "July 23 to August 22" + character + "" +character + "Traditional Leo Traits" + character + "Generous and warmhearted" + character + "Creative and enthusiastic" + character + "Broad-minded and expansive" + character + "Faithful and loving" + character + "" +character + "On the dark side...." + character + "Pompous and patronizing" + character + "Bossy and interfering" + character + "Dogmatic and intolerant") endsub sub Virgo GraphicsWindow.DrawBoundText(270,125,470,"Virgo - The Virgin" + character + "August 23 to September 23" + character + "" +character + "Traditional Virgo Traits" + character + "Modest and shy" + character + "Meticulous and reliable" + character + "Practical and diligent" + character + "Intelligent and analytical" + character + "" +character + "On the dark side...." + character + "Fussy and a worrier" + character + "Overcritical and harsh" + character + "Perfectionist and conservative") endsub sub Libra GraphicsWindow.DrawBoundText(270,125,470,"Libra - The Scales" + character + "September 24 to October 23" + character + "" +character + "Traditional Libra Traits" + character + "Diplomaitic and urbane" + character + "Romantic and charming" + character + "Easygoing and sociable" + character + "Idealistic and peaceable" + character + "" +character + "On the dark side...." + character + "Indecisive and changeable" + character + "Gullible and easily infuenced" + character + "Flirtatious and self-indulgent") endsub sub Scorpio GraphicsWindow.DrawBoundText(270,125,470,"Scorpio - The Scorpion" + character + "October 24 to November 22" + character + "" +character + "Traditional Scorpio Traits" + character + "Determined and forceful" + character + "Emotional and intuitive" + character + "Powerful and passionate" + character + "Exciting and magnetic" + character + "" +character + "On the dark side...." + character + "Jealous and resentful" + character + "Compulsive and obsessive" + character + "Secretive and obstinate") endsub sub Sagittarius GraphicsWindow.DrawBoundText(270,125,470,"Sagittarius - The Archer" + character + "November 23 to December 21" + character + "" +character + "Traditional Sagittarius Traits" + character + "Optimistic and freedom-loving" + character + "Jovial and good-humored" + character + "Honest and straightforward" + character + "Intellectual and philosophical" + character + "" +character + "On the dark side...." + character + "Blindly optimistic and careless" + character + "Irresponsible and superficial" + character + "Tactless and restless") endsub End>QKQ309.sb< Start>QKQ924.sb< f[1]=1 f[2]=2 GraphicsWindow.BackgroundColor="darkgreen GraphicsWindow.BrushColor="lime GraphicsWindow.Height=999 GraphicsWindow.Width=1200 For I=3 To 10 f[I]=f[I-2]+f[I-1] EndFor' I For I=0 To 100 Zss="" Sss=" " Z=I For J=10 To 1 Step -1 If J=1 Then Sss="." EndIf If ZQKQ924.sb< Start>QKR009-0.sb< DEBUG() Initialise() 'Register Events GraphicsWindow.MouseMove = OnMouseMove '====================================================== 'Game Loop '====================================================== While "True" start = Clock.ElapsedMilliseconds 'Update Program - put in Sub UpdateProgram If mouseMoving And Mouse.IsLeftButtonDown = "True" Then X = GraphicsWindow.MouseX Y = GraphicsWindow.MouseY mouseMoving = "False" 'you'll need this if you add more events EndIf 'Update Frame - put in Sub UpdateFrame GraphicsWindow.PenColor = "Yellow" GraphicsWindow.DrawEllipse(X, Y, 3, 3) GraphicsWindow.PenColor = "Green" GraphicsWindow.DrawEllipse(X, gh-Y, 3, 3) 'Constant Frame Rate of 1000/10 per second. That's a whopping 100 fps delay = 10 - (Clock.ElapsedMilliseconds - start) If delay > 0 Then Program.Delay(delay) Else TextWindow.WriteLine("updates > 10ms") EndIf EndWhile '=================================================== 'Event Subroutine '=================================================== Sub OnMouseMove mouseMoving = "True" EndSub '=================================================== 'Subroutines '=================================================== Sub Initialise GraphicsWindow.Title = "Drawing Mirror" gw = 500 gh = 500 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Top = 10'(Desktop.Height - 500)/2 GraphicsWindow.Left = (Desktop.Width - gw)/2 GraphicsWindow.BackgroundColor = "Black" EndSub Sub DEBUG TextWindow.Left = 20 TextWindow.Top = gh + 20 EndSub End>QKR009-0.sb< Start>QKR009-1.sb< 'Logic by Jibba Jabba 'I, Josh Miedema, added some things: Clear, change colour, change mirror, and eraser, as well as expanding on the amount of available mirrors. 'I am also planning on adding the ability to mirror vertically as well as horizontally at the same time. Maybe even the two diagonals, too! We'll see. 'Set the Eraser Function to False because you can't draw with an eraser:P Eraser = "False" 'Run Subroutines '-Debugger console (also handles the getting of info: colours and mirror position) DEBUG() '-Gets the type of mirror to use (using the debugger) GetMirrorPos() '-Gets colours (Leave blank to use defaults) (also uses debugger) GetColours() '-This sets up the graphics window Initialise() 'Register Events GraphicsWindow.MouseMove = OnMouseMove Controls.ButtonClicked = ButtonClick '====================================================== '|| Game Loop || '====================================================== While "True" start = Clock.ElapsedMilliseconds 'Update Program If mouseMoving And Mouse.IsLeftButtonDown = "True" Then X = GraphicsWindow.MouseX Y = GraphicsWindow.MouseY mouseMoving = "False" EndIf 'Update Frame '-Removes the mirror line (Helps for the "Change Mirror" button) Shapes.Remove(Mirror) '-Resets background colour (Helps for the "Change Colour" button GraphicsWindow.BackgroundColor = BackgroundColour '-Checks that the Eraser state is set to false... If Eraser = "False" Then '...So it can use normal colours. GraphicsWindow.PenColor = OriginalColour GraphicsWindow.DrawEllipse(X, Y, 3, 3) 'This IF statement will determine where the copies will be drawn depending on what mirror the user chose. If Option = "1" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 250, 500, 250) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(X, gh-Y, 3, 3) ElseIf Option = "2" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(250, 0, 250, 500) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(gw-X, Y, 3, 3) ElseIf Option = "3" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 0, 500, 500) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(Y, X, 3, 3) ElseIf Option = "4" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(500, 0, 0, 500) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(gw-Y, gh-X, 3, 3) ElseIf Option = "5" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 250, 500, 250) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(X/2+125, gh-Y/2-125, 3, 3) ElseIf Option = "6" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(250, 0, 250, 500) GraphicsWindow.PenColor = CopyColour GraphicsWindow.DrawEllipse(gw-X/2-125, Y/2+125, 3, 3) EndIf 'But if the eraser is turned on, adjust all colours to be the background colour. ElseIf Eraser = "True" Then GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(X, Y, 7, 7) 'Again, this will determine where the copies will be placed. This time for the eraser. If Option = "1" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 250, 500, 250) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(X, gh-Y, 7, 7) ElseIf Option = "2" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(250, 0, 250, 500) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(gw-X, Y, 7, 7) ElseIf Option = "3" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 0, 500, 500) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(Y, X, 7, 7) ElseIf Option = "4" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(500, 0, 0, 500) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(gw-Y, gh-X, 7, 7) ElseIf Option = "5" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(0, 250, 500, 250) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(X/2+125, gh-Y/2-125, 7, 7) ElseIf Option = "6" Then GraphicsWindow.PenColor = MirrorColour Mirror = Shapes.AddLine(250, 0, 250, 500) GraphicsWindow.PenColor = GraphicsWindow.BackgroundColor GraphicsWindow.DrawEllipse(gw-X/2-125, Y/2+125, 7, 7) EndIf EndIf 'Constant Frame Rate of 1000/10 per second. That's a whopping 100 FPS --> YAY! Thanks! delay = 10 - (Clock.ElapsedMilliseconds - start) If delay > 0 Then TextWindow.WriteLine("updates < 10ms") Program.Delay(delay) Else 'I added this just because I wanted to see how often it'd show, but it flashes for the briefest time! TextWindow.WriteLine("updates > 10ms") EndIf EndWhile '=================================================== 'Event Subroutines '=================================================== 'Mouse Move Sub OnMouseMove mouseMoving = "True" EndSub 'Button Click Sub ButtonClick 'This IF statement checks what the last button was '-Clear Button If Controls.LastClickedButton = Clear Then 'Clear window and re-add buttons GraphicsWindow.Clear() Clear = Controls.AddButton("Clear", 0, 500) Controls.SetSize(Clear, 50, 30) ChangeMirror = Controls.AddButton("Change Mirror", 50, 500) Controls.SetSize(ChangeMirror, 100, 30) ChangeColours = Controls.AddButton("Change Colours", 150, 500) Controls.SetSize(ChangeColours, 100, 30) EraserButton = Controls.AddButton("Eraser Off", 250, 500) Controls.SetSize(EraserButton, 150, 30) '-Change Mirror Button ElseIf Controls.LastClickedButton = ChangeMirror Then GetMirrorPos() '-Change Colours Button ElseIf Controls.LastClickedButton = ChangeColours Then GetColours() '-Eraser Button ElseIf Controls.LastClickedButton = EraserButton Then 'Checks the state of the eraser when the button is clicked '-If the eraser was enabled when the button was clicked, turn it off If Eraser = "True" Then Eraser = "False" 'And set the button caption to off Controls.SetButtonCaption(EraserButton, "Eraser Off") '-If the eraser was disabled when the button was clicked, turn it on ElseIf Eraser = "False" Then Eraser = "True" 'And set the button caption to on Controls.SetButtonCaption(EraserButton, "Eraser On") EndIf EndIf EndSub '=================================================== 'Other Subroutines '=================================================== Sub Initialise 'Fairly straight forward here... GraphicsWindow.Title = "Drawing Mirror" gw = 500 gh = 500 GraphicsWindow.Width = gw GraphicsWindow.Height = gh + 30 GraphicsWindow.Top = 10'(Desktop.Height - 500)/2 GraphicsWindow.Left = (Desktop.Width - gw)/2+50 GraphicsWindow.BackgroundColor = BackgroundColour GraphicsWindow.Clear() Clear = Controls.AddButton("Clear", 0, 500) Controls.SetSize(Clear, 50, 30) ChangeMirror = Controls.AddButton("Change Mirror", 50, 500) Controls.SetSize(ChangeMirror, 100, 30) ChangeColours = Controls.AddButton("Change Colours", 150, 500) Controls.SetSize(ChangeColours, 100, 30) EraserButton = Controls.AddButton("Eraser Off", 250, 500) Controls.SetSize(EraserButton, 150, 30) EndSub 'Sets up the debug console (also used to ask user for mirror type and colours) Sub DEBUG TextWindow.Left = 20 TextWindow.Top = gh + 20 EndSub 'Asks the user for the mirror type using debug console Sub GetMirrorPos TextWindow.Clear() Program.Delay(10) TextWindow.WriteLine("[1] Horizontal Mirror") TextWindow.WriteLine("[2] Vertical Mirror") TextWindow.WriteLine("[3] Diagonal Mirror (Top Left to Bottom Right)") TextWindow.WriteLine("[4] Diagonal Mirror (Top Right to Bottom Left)") TextWindow.WriteLine("[5] Draw Half-Scale on Horizontal Mirror") TextWindow.WriteLine("[6] Draw Half-Scale on Vertical Mirror") TextWindow.Write("--> ") Option = TextWindow.Read() EndSub 'Asks the user for the colours to use using the debug console Sub GetColours TextWindow.Clear() Program.Delay(10) 'Asks for background colour: TextWindow.Write("Background Colour: ") BackgroundColour = TextWindow.Read() 'This IF statement checks the background colour Var. to see if it's empty. If so, set it to my default If BackgroundColour = "" Then BackgroundColour = "Black" EndIf 'Asks for the "Original Colour" whick is the one the user draws with TextWindow.Write("Original Colour: ") OriginalColour = TextWindow.Read() 'This IF statement checks the original colour Var. to see if it's empty. If so, set it to my default If OriginalColour = "" Then OriginalColour = "Yellow" EndIf 'Asks for the "Copy" colour which is the one that the computer uses to draw mirror (using mirror type) TextWindow.Write("Copy Colour: ") CopyColour = TextWindow.Read() 'This IF statement checks the copy colour Var. to see if it's empty. If so, set it to my default If CopyColour = "" Then CopyColour = "Green" endIf 'Asks for the mirror colour which is the colour used to show the mirror line. Kind of a bad name to use because people might think it's for the mirror drawing... TextWindow.Write("Mirror Colour: ") MirrorColour = TextWindow.Read() 'This IF statement checks the mirror colour Var. to see if it's empty. If so, set it to my default If MirrorColour = "" Then MirrorColour = "Gray" EndIf EndSub End>QKR009-1.sb< Start>QKR009.sb< 'Logic (C) 2013 by JOman Mied (Josh Miedema) 'Version 1 'Take it easy... This program kept crashing on my computer because I was trying to draw too fast... Maybe it's the logic I'm using? 'Slower movements are okay though. 'My computer has a Dual-Core processor running at 1.7 GHz ... If you have anything better than that, change the Program.Delay() values to make it run better :P 'I have code at the bottom for a CPU Load Reducer that tries to pause the program when CPU Load is above 90% 'Feel free to tinker with it, maybe make it a While Loop so it will stay paused until load drops. 'GW Setup GraphicsWindow.Title = "Drawing Mirror" GraphicsWindow.Width = 500 GraphicsWindow.Height = 500 GraphicsWindow.Top = 0'(Desktop.Height - 500)/2 GraphicsWindow.Left = 0'(Desktop.Width - 500)/2 GraphicsWindow.BackgroundColor = "Black" 'Watch for Mouse Move GraphicsWindow.MouseMove = MouseMove 'MouseMove Sub Sub MouseMove 'While GW is being clicked While Mouse.IsLeftButtonDown = "True" 'Put If... here if you want to (First Spot) 'Get X/Y Co-ords of Mouse X = Mouse.MouseX - 10 Y = Mouse.MouseY - 30 'Draw where mouse is GraphicsWindow.PenColor = "Yellow" GraphicsWindow.DrawEllipse(X, Y, 3, 3) 'Pause for 20 ms and then draw mirror Program.Delay(20) GraphicsWindow.PenColor = "Green" GraphicsWindow.DrawEllipse(500-X, 500-Y, 3, 3) 'Small delay before doing this again Program.Delay(5) 'Put elseif...endif here if you want to (Second Spot) EndWhile EndSub '>>-------------------------CPU Load reducer---------------------------<< 'This stuff goes into the while loop within the MouseMove Subroutine. You'll find comments about where to put it. 'Either delete those comments when you move this code or keep them, the compiler doesn't mind :P 'This If...ElseIf...End statement is makes sure the program pauses if CPU is over 90% but runs if CPU is under 90% load '------------------First Chunk (Goes in first spot for this code)------------------- 'If Hardware.CPUUsage < 90 Then ' 'Remove pause message ' Shapes.Remove(Pause) '-----------------Second Chunk (Goes in second spot for this code)------------------- 'ElseIf Hardware.CPUUsage > 90 then ' 'Try to slow program a bit ' Program.Delay(20) ' 'Display message ' GraphicsWindow.BrushColor = "Red" ' Pause = Shapes.AddText("CPU over 90% Load. Waiting...") ' Shapes.Move(Pause, 50, 250) 'EndIf '>>-----------------------That's All, Folks!-------------------------------<< End>QKR009.sb< Start>QKR631.sb< 'Create a random 500 element array numVal = 500 For i = 1 To numVal val[i] = Math.GetRandomNumber(numVal) EndFor valStore = val 'ShellSort it val = valStore start = Clock.ElapsedMilliseconds shellsort() timing = 0.001*(Clock.ElapsedMilliseconds-start) TextWindow.WriteLine("ShellSort "+timing) 'BubbleSort it val = valStore start = Clock.ElapsedMilliseconds bubblesort() timing = 0.001*(Clock.ElapsedMilliseconds-start) TextWindow.WriteLine("BubbleSort "+timing) Sub shellsort inc = Math.Round(numVal/2) While inc > 0 For i = inc To numVal temp = val[i] j = i while (j >= inc) and (val[j-inc] > temp) val[j] = val[j-inc] j = j - inc EndWhile val[j] = temp EndFor inc = Math.Round(inc/2.2) Endwhile Endsub Sub bubblesort For i = 1 To numVal For j = i+1 To numVal If (val[j] < val[i]) Then temp = val[i] val[i] = val[j] val[j] = temp EndIf EndFor EndFor EndSub End>QKR631.sb< Start>QKT493.sb< GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GW = 600 GraphicsWindow.Width = GW GraphicsWindow.Height = GW TextWindow.Left=900 ProgramDirectory=Program.Directory GraphicsWindow.PenColor="Black" GraphicsWindow.BrushColor="Green" For i = 1 to 5 BlockHeight[i]=Math.GetRandomNumber(195)+50 BlockWidth[i]=Math.GetRandomNumber(195)+50 Block[i]=Shapes.AddRectangle(BlockWidth[i],BlockHeight[i]) Shapes.Move(Block[i],Math.GetRandomNumber(GW),Math.GetRandomNumber(GW)+50) BlockX[i] = shapes.GetLeft(Block[i]) BlockY[i] = shapes.GetTop(Block[i]) endfor GraphicsWindow.BrushColor="LightBlue" Player[1]=Shapes.AddRectangle(20,20) PlayerRagdoll[1]=Shapes.AddRectangle(20,20) GraphicsWindow.BrushColor="Red" Player[2]=Shapes.AddRectangle(20,20) PlayerRagdoll[2]=Shapes.AddRectangle(20,20) Shapes.Move(Player[2],500,0) GraphicsWindow.PenWidth=10 GraphicsWindow.PenColor="LightGreen" PlayerHPBar[1]=Shapes.AddLine(0,0,60,0) PlayerHPBar[2]=Shapes.AddLine(0,0,60,0) GraphicsWindow.PenWidth=0 GraphicsWindow.BrushColor="Yellow" ItemPistol=Shapes.AddRectangle(20,20) GraphicsWindow.BrushColor="Orange" ItemShotgun=Shapes.AddRectangle(20,20) PistolPosition = math.GetRandomNumber(5) Shapes.Move(ItemPistol,BlockX[PistolPosition],BlockY[PistolPosition]-30) ShotgunPosition = math.GetRandomNumber(5) Shapes.Move(ItemShotgun,BlockX[ShotgunPosition],BlockY[ShotgunPosition]-30) GraphicsWindow.PenWidth=10 GraphicsWindow.PenColor="Black" Restart() Sub Restart Shift[1]=0 Left[1]=0 Right[1]=0 Up[1]=0 Down[1]=0 Shot[1] = 0 HPPlayer[1]=100 WeaponPlayer[1]="Pistol" Shift[2]=0 Left[2]=0 Right[2]=0 Up[2]=0 Down[2]=0 Enemy="Human" WeaponPlayer[2]="Pistol" BulletXMain[1] = 1 BulletXMain[2] = 1 endsub While "True" For i = Array.GetItemCount(Bullet)-5 To Array.GetItemCount(Bullet) Shapes.Move(Bullet[i],shapes.GetLeft(Bullet[i])+BulletX[i], Shapes.GetTop(Bullet[i])+BulletY[i]) Shapes.Remove(Bullet[Array.GetItemCount(Bullet)-5]) If Shapes.GetLeft(Bullet[i])>GW or Shapes.GetLeft(Bullet[i])<0 then Shapes.Remove(Bullet[i]) endif If Shapes.GetLeft(Bullet[i]) >= PlayerX[2] And Shapes.GetLeft(Bullet[i]) <= PlayerX[2]+20 And Shapes.GetTop(Bullet[i]) >= PlayerY[2] And Shapes.GetTop(Bullet[i]) <= PlayerY[2]+20 Then TextWindow.WriteLine("HIT") HPPlayer[2] = HPPlayer[2]-10 Shapes.Remove(Bullet[i]) endif endfor For i = 1 To 2 Shapes.Zoom(PlayerHPBar[i],HPPlayer[i]/100,1) If PlayerX[i]+20 >= Shapes.GetLeft(ItemShotgun) And PlayerX[i] <= Shapes.GetLeft(ItemShotgun)+20 And PlayerY[i] >= Shapes.GetTop(ItemShotgun) And PlayerY[i] <= Shapes.GetTop(ItemShotgun)+20 Then ' TextWindow.WriteLine("SHOTGUN AQUIRED!") Shapes.Remove(ItemShotgun) WeaponPlayer[i]="Shotgun" endif If HPPlayer[i] < 1 Then Shapes.Move(PlayerRagdoll[i],PlayerX[i],PlayerY[i]) PlayerRagdollWX[i] = PlayerWX[i] PlayerRagdollWY[i] = PlayerWY[i] Shapes.Move(Player[i],20,20) HPPlayer[i]=100 endif If playerWY[i]<0.9 Then playerWY[i]=PlayerWY[i]+0.005 endif PlayerX[i] = shapes.GetLeft(Player[i]) PlayerY[i] = shapes.GetTop(Player[i]) PlayerRagdollX[i] = Shapes.GetLeft(PlayerRagdoll[i]) PlayerRagdollY[i] = Shapes.GetTop(PlayerRagdoll[i]) If PlayerTG[i] > 0 Then PlayerWX[i] = PlayerWX[i] * 0.95 If Right[i]=1 And PlayerWX[i]<0.4 Then PlayerWX[i] = PlayerWX[i] + 0.03 elseif Left[i] = 1 And PlayerWX[i]>-0.4 then PlayerWX[i] = PlayerWX[i] - 0.03 endif Else PlayerWX[i] = PlayerWX[i] * 0.999 If Right[i]=1 And PlayerWX[i]<0.4 Then PlayerWX[i] = PlayerWX[i] + 0.01 elseif Left[i] = 1 And PlayerWX[i]>-0.4 then PlayerWX[i] = PlayerWX[i] - 0.001 endif endif If Left[i] = 1 Then BulletXMain[i] = -1 endif If Right[i] = 1 then BulletXMain[i] = 1 endif Boundaries() Collision() Shapes.Move(PlayerHPBar[i],PlayerX[i]-20,PlayerY[i]-10) If PlayerRagdollX[i] > 0 and PlayerRagdollX[i] < GW and PlayerRagdollY[i] > 0 and PlayerRagdollY[i] < GW then Shapes.Move(PlayerRagdoll[i],PlayerRagdollX[i]+PlayerRagdollWX[i],PlayerRagdollY[i]+PlayerRagdollWY[i]) PlayerRagdollWX[i] = PlayerRagdollWX[i] * 0.999 If PlayerRagdollWY[i]<0.9 Then PlayerRagdollWY[i]=PlayerRagdollWY[i]+0.005 endif endif If HPOld[i]<>HPPlayer[i] then Shapes.Remove(PlayerHPBar[i]) GraphicsWindow.PenColor=GraphicsWindow.GetColorFromRGB(200,HPPlayer[i]*2.5,0) PlayerHPBar[i]=Shapes.AddLine(0,0,60,0) endif hpold[i]=HPPlayer[i] endfor If Enemy = "CPU" Then AI() endif For i = 1 To 2 Shapes.Move(Player[i],PlayerX[i]+PlayerWX[i],PlayerY[i]+PlayerWY[i]) TextWindow.WriteLine(PlayerTG[i]) endfor Program.Delay(1) TextWindow.Clear() Endwhile '=======================ON KEY DOWN============================= Sub OnKeyDown Key = GraphicsWindow.LastKey If (Key = "Left") Then Left[1] = 1 ElseIf (Key = "Right") Then Right[1] = 1 ElseIf (Key = "Up") Then Up[1] = 1 ElseIf (Key = "Down") Then Down[1] = 1 ElseIf (Key = "RightShift") Then Shift[1] = 1 ElseIf (Key = "RightCtrl" and Shot[1] = 0) Then BulletShot() ElseIf (Key = "A") Then Left[2] = 1 ElseIf (Key = "D") Then Right[2] = 1 ElseIf (Key = "W") Then Up[2] = 1 ElseIf (Key = "LeftShift") Then Shift[2] = 1 ElseIf (Key = "LeftCtrl") and Shot[2] = 0 Then BulletShot2() ElseIf (Key = "D1") Then WeaponPlayer[1]="Pistol" ElseIf (Key = "D2") Then WeaponPlayer[1]="Shotgun" EndIf EndSub '=======================ON KEY UP================================ Sub OnKeyUp Key = GraphicsWindow.LastKey If (Key = "Left") Then Left[1] = 0 ElseIf (Key = "Right") Then Right[1] = 0 ElseIf (Key = "Up") Then Up[1] = 0 ElseIf (Key = "Down") Then Down[1] = 0 ElseIf (Key = "RightShift") Then Shift[1] = 0 ElseIf (Key = "RightCtrl") Then Shot[1] = 0 ElseIf (Key = "A") Then Left[2] = 0 ElseIf (Key = "D") Then Right[2] = 0 ElseIf (Key = "W") Then Up[2] = 0 ElseIf (Key = "LeftShift") Then Shift[2] = 0 ElseIf (Key = "LeftCtrl") Then Shot[2] = 0 endif EndSub '=======================COLLISION================================ Sub Collision For n = 1 To 5 IF PlayerY[i]+20 >= BlockY[n] and PlayerY[i] <= BlockY[n]+BlockHeight[n] then If PlayerX[i]+20 > BlockX[n] and PlayerX[i]+20 < BlockX[n]+1 then playerWX[i] = -0.01 elseif PlayerX[i] < BlockX[n]+BlockWidth[n] and PlayerX[i] > BlockX[n]-1 then playerWX[i] = 0.01 endif ELSEIF PlayerX[i]+20 >= BlockX[n] and PlayerX[i] <= BlockX[n]+BlockWidth[n] then If PlayerY[i]+21 > BlockY[n] and PlayerY[i] < BlockY[n]+1 then if Shift[i] = 1 then playerWY[i] = -1 else playerWY[i] = 0 PlayerTG[i] = n n = 5 endif Elseif PlayerY[i]-1 < BlockY[n]+BlockHeight[n] and PlayerY[i] > BlockY[n]+BlockHeight[n]-1 and PlayerWY[i] < 0 then playerWY[i] = 0.01 Endif ELSE PlayerTG[i] = 0 ENDIF EndFor endsub '=======BOUNDARIES========= sub Boundaries If PlayerY[i]<0 Then playerY[i] = 1 ElseIf PlayerY[i]>GW-20 then PlayerY[i] = 0 endif If PlayerX[i]<0 Then playerWX[i] = 0.01 ElseIf PlayerX[i] > GW-20 then playerWX[i] = -0.01 endif endsub '==================SUB BULLETSHOT======================== Sub Bulletshot GraphicsWindow.PenColor="Black" If WeaponPlayer[1]="Pistol" then b=b+1 Bullet[b]=Shapes.AddRectangle(5,5) Shapes.Move(Bullet[b],playerX[1]+8,PlayerY[1]+7) BulletX[b] = BulletXMain[1]*5 If Up[1] = 1 Then BulletY[b] = -5 If Right[1] = 0 And Left[1] = 0 then BulletX[b] = 0 endif ElseIf Down[1] = 1 then BulletY[b] = 5 If Right[1] = 0 And Left[1] = 0 then BulletX[b] = 0 endif elseif Down[1] = 0 and Up[1] = 0 then BulletY[b] = 0 endif Elseif WeaponPlayer[1]="Shotgun" then For s = 1 To 5 b=b+1 Bullet[b]=Shapes.AddRectangle(5,5) Shapes.Move(Bullet[b],playerX[1]+8,PlayerY[1]+7) BulletX[b] = BulletXMain[1]*5 If Up[1] = 1 Then BulletY[b] = -5 If Right[1] = 0 And Left[1] = 0 then BulletX[b] = Math.GetRandomNumber(4.5)-2.5 endif ElseIf Down[1] = 1 then BulletY[b] = 5 If Right[1] = 0 And Left[1] = 0 then BulletX[b] = Math.GetRandomNumber(4.5)-2.5 endif elseif Down[1] = 0 and Up[1] = 0 then BulletY[b] = Math.GetRandomNumber(4.5)-2.5 endif endfor endif Shot[1] = 1 endsub Sub Bulletshot2 endsub Sub AI If PlayerX[2] < PlayerX[1]-25 Then If PlayerTG[2] = "True" then If PlayerWX[2]<0.4 Then PlayerWX[2] = PlayerWX[2] + 0.03 endif ElseIf PlayerTG[2] = "False" then if PlayerWX[2]>0.25 then PlayerWX[2] = PlayerWX[2] + 0.001 endif endif ElseIf PlayerX[2]-25 > PlayerX[1] Then If PlayerTG[2] = "True" then If PlayerWX[2]>-0.4 Then PlayerWX[2] = PlayerWX[2] - 0.03 endif elseIf PlayerTG[2] = "False" then if PlayerWX[2]>-0.25 then PlayerWX[2] = PlayerWX[2] - 0.001 endif endif endif if PlayerTG[2] = "True" then If PlayerY[1]+50 < PlayerY[2] Then PlayerWY[2] = -1 Else PlayerWY[2] = 0 endif endif EndSub If i > 2 then Shapes.Move(Block[i],400,300) 'Shapes.Move(Block[i],Math.GetRandomNumber(GW),Math.GetRandomNumber(GW)+50) 'Shapes.Move(Block[i],400,300) else Shapes.Move(Block[i],0,300) 'Shapes.Move(Block[i],Math.GetRandomNumber(GW),Math.GetRandomNumber(GW)+50) Shapes.Move(Block[i],0,300) 'Shapes.Move(Block[i],Math.GetRandomNumber(GW),Math.GetRandomNumber(GW)+50) endif If WeaponPlayer[1]="Shotgun" then For s = 1 To 5 b=b+1 Bullet[b]=Shapes.AddRectangle(5,5) Shapes.Move(Bullet[b],playerX[1]+8,PlayerY[1]+7) BulletX[b] = BulletXMain[1]*5 If Up[1] = 1 Then BulletY[b] = Math.GetRandomNumber(3.55)-4.55 If Right[1] = 0 And Left[1] = 0 then BulletX[b] = 0 endif ElseIf Down[1] = 1 then BulletY[b] = Math.GetRandomNumber(5.55) If Right[1] = 0 And Left[1] = 0 then BulletX[b] = 0 endif elseif Down[1] = 0 and Up[1] = 0 then BulletY[b] = 0 endif endfor endif Shot[1] = 1 End>QKT493.sb< Start>QKT593.sb< 'Copyright(c)All Rights Reserved. 'Made by ProfessionalOfSmallBasic[POSB] 'Made date :06.04.2014 15:45 'Thanks For Playing materials() 'Start Game Sub gamerZ game() meteor() wrongway() x=x+m EndSub 'Initialise Sub initialise GraphicsWindow.Clear() back=ImageList.LoadImage("http://lparchive.org/Gazillionaire-Deluxe/Update%2048/26-SPACE.png") GraphicsWindow.DrawImage(back,0,0) rocket=ImageList.LoadImage("http://theponga.com/img/soon/rocket.png") rock=Shapes.AddImage(rocket) x=300 y=300 m=0 GraphicsWindow.KeyDown=keydown EndSub 'Rocket's move-Score Sub game Shapes.Move(rock,x,y) score() For t = 1 To numberofmeteors 'Do all of your movement and collision checks from here' y[t] = y[t] + 2 Shapes.Move(mete[t],x[t],y[t]) If y[t] > GraphicsWindow.Height Then x[t] = Math.GetRandomNumber(GraphicsWindow.Width) y[t] = 0-Math.GetRandomNumber(GraphicsWindow.Height) score=score+1 Endif EndFor EndSub 'Keys Sub keydown last=GraphicsWindow.LastKey If last="Left" Then m=-2 EndIf If last="Right" Then m=2 EndIf EndSub 'WrongWays Sub wrongway If x=-10 Then m=-m EndIf If x=604 Then m=-m EndIf EndSub 'meteor's move Sub meteor numberofmeteors = 15 For i = 1 To numberofmeteors meteimg[i] = ImageList.LoadImage("http://media.indiedb.com/cache/images/games/1/26/25272/thumb_300x150/Asteroids_32x32_006.png") mete[i] = Shapes.AddImage(meteimg[i]) x[i] = Math.GetRandomNumber(GraphicsWindow.Width) y[i] = 0-Math.GetRandomNumber(GraphicsWindow.Height) EndFor EndSub 'rocket crash Sub materials GraphicsWindow.Show() initialise() score=1 star: gamerZ() Goto star EndSub Sub score GraphicsWindow.Title="score: "+score EndSub End>QKT593.sb< Start>QLB611.sb< EMS = Clock.ElapsedMilliseconds Length = Text.GetLength(EMS) Rand = Text.GetSubText(EMS,Length,1) TextWindow.WriteLine(Rand) End>QLB611.sb< Start>QLF691.sb< GraphicsWindow.Title="Neopixel scroll 4 Arduino Uno GraphicsWindow.Height =200 GraphicsWindow.Width =1200 GraphicsWindow.BackgroundColor ="teal pp=LDCommPort.OpenPort ("COM12" 115200)'----------9 Then s1=3 endif EndFor dm[r]=ldtext.Replace (dm[r] "-" 0) dm[r]=ldtext.Replace (dm[r] " " 0) EndFor f3=1.2 ii=0 For px=1 To Text.GetLength (tm[1]) For py=1 To 8 t=text.GetSubText (dm[py] px 1) If t=0 Then GraphicsWindow.BrushColor=LDColours.HSLtoRGB (180 1 .2) else GraphicsWindow.BrushColor=clr[t] endif GraphicsWindow.FillEllipse (250+px*15 py*15 14 14) EndFor EndFor While "true"'---------------------------------------------------------mainloop ii=0 For py=5 To 1 Step -1 For px=1 To 8 cc=clr[text.GetSubText ( dm[px] py+Math.Remainder (oo 55) 1)] If cc="#000000" then GraphicsWindow.BrushColor="teal else GraphicsWindow.BrushColor =cc endif GraphicsWindow.FillRectangle (px*20 py*20 20 20) co=ii+" " co=text.Append (co math.Floor(math.SquareRoot (LDColours.GetRed (cc)/f3))+" ") co=text.Append (co math.Floor(math.SquareRoot (LDColours.GetGreen (cc)/f3))+" ") co=text.Append (co math.Floor(math.SquareRoot (LDColours.GetBlue (cc)/f3))) ii=ii+1 rr=LDCommPort.TXString (co+nn) Program.Delay (3)'-----------------------adjust arduino cmd delay EndFor EndFor oo=oo+1 Program.Delay (12)'---------------scroll delay endwhile End>QLF691.sb< Start>QLG339-0.sb< ' Draw Web ' Version 0.2 ' Copyright © 2019 Nonki Takahashi. The MIT License. ' Last update 2019-10-05 ' Program ID QLG339-0 GraphicsWindow.Title = "Web 0.2" GraphicsWindow.BackgroundColor = "DimGray" pc = "LightGray" gw = GraphicsWindow.Width gh = GraphicsWindow.Height debug = "False" If debug Then GraphicsWindow.Width = gw + 200 GraphicsWindow.Height = gh + 200 EndIf GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillRectangle(0, 0, gw, gh) gd = Math.SquareRoot(gw * gw + gh * gh) * 0.8 x[0] = gw / 2 y[0] = gh / 2 size = 6 gap = 16 GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "#6633FFFF" shp[0] = Shapes.AddEllipse(size, size) Shapes.Move(shp[0], x[0] - size / 2, y[0] - size / 2) a = 22.5 For i = 1 To 8 ' end point _a = Math.GetRadians(a) x[i] = x[0] + Math.Round(gd * Math.Cos(_a)) y[i] = y[0] + Math.Round(gd * Math.Sin(_a)) a = a + 45 EndFor a = 22.5 r = gap sx = x[0] While r < gd ' spiral point _a = Math.GetRadians(a) n = i x[i] = x[0] + Math.Round(r * Math.Cos(_a)) e2 = Math.Remainder(i - 1, 8) + 1 ex = x[e2] s = 0.4 / Math.Abs(sx - ex) dy[i] = s * Math.Abs((x[i] - sx) * (x[i] - ex)) y[i] = y[0] + Math.Round(r * Math.Sin(_a)) shp[i] = Shapes.AddEllipse(size, size) Shapes.Move(shp[i], x[i] - size / 2, y[i] - size / 2 + dy[i]) i = i + 1 a = a + 45 r = r * 1.07 EndWhile GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = pc spiral = "False" For k = 1 To 8 ' connect center to end i1 = 0 sx = x[i1] e2 = k ex = x[e2] ey = y[e2] s = 0.4 / Math.Abs(sx - ex) _i = 0 For j = k + 8 To n Step 8 i2 = j AddDots() i1 = i2 _i = j EndFor i2 = e2 AddDots() EndFor _i = 9 spiral = "True" For j = 9 To n ' connect spiral i2 = j If 9 < j Then sx = x[i1] ex = x[i2] AddDots() _i = j EndIf i1 = i2 EndFor Sub AddDots ' param i1, i2 - start and end point index ' param gap - minimum gap between points _x = x[i2] - x[i1] _y = y[i2] - y[i1] len = Math.SquareRoot(_x * _x + _y * _y) m = Math.Floor(len / gap) If 2 <= m Then r = 1 / m For l = 1 To m - 1 i = i + 1 x[i] = x[i1] * (1 - r) + x[i2] * r dy[i] = s * Math.Abs((x[i] - sx) * (x[i] - ex)) If spiral Then y[i] = (y[i1] + dy[i1]) * (1 - r) + (y[i2] + dy[i2]) * r Else y[i] = y[i1] * (1 - r) + y[i2] * r EndIf GraphicsWindow.PenWidth = 0 shp[i] = Shapes.AddEllipse(size, size) Shapes.Move(shp[i], x[i] - size / 2, y[i] - size / 2 + dy[i]) If _i <> "" Then GraphicsWindow.PenWidth = 2 GraphicsWindow.DrawLine(x[_i], y[_i] + dy[_i], x[i], y[i] + dy[i]) EndIf _i = i r = r + 1 / m EndFor EndIf If spiral Or (_i <> "") Then GraphicsWindow.PenWidth = 2 GraphicsWindow.DrawLine(x[_i], y[_i] + dy[_i], x[i2], y[i2] + dy[i2]) GraphicsWindow.PenColor = pc EndIf EndSub End>QLG339-0.sb< Start>QLG339.sb< ' Draw Web ' Version 0.1 ' Copyright © 2019 Nonki Takahashi. The MIT License. ' Last update 2019-10-05 GraphicsWindow.Title = "Web 0.1" GraphicsWindow.BackgroundColor = "Black" gw = GraphicsWindow.Width gh = GraphicsWindow.Height gd = Math.SquareRoot(gw * gw + gh * gh) x[0] = gw / 2 y[0] = gh / 2 size = 6 gap = 16 GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "#9933FFFF" shp[0] = Shapes.AddEllipse(size, size) Shapes.Move(shp[0], x[0] - size / 2, y[0] - size / 2) a = 22.5 For i = 1 To 8 _a = Math.GetRadians(a) x[i] = x[0] + gd / 2 * Math.Cos(_a) y[i] = y[0] + gd / 2 * Math.Sin(_a) a = a + 45 EndFor a = 22.5 r = gap While r < gd * 0.8 _a = Math.GetRadians(a) n = i x[i] = x[0] + r * Math.Cos(_a) y[i] = y[0] + r * Math.Sin(_a) shp[i] = Shapes.AddEllipse(size, size) Shapes.Move(shp[i], x[i] - size / 2, y[i] - size / 2) i = i + 1 a = a + 45 r = r * 1.07 EndWhile GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "LightGray" For k = 1 To 8 x1 = x[0] y1 = y[0] For j = k + 8 To n Step 8 x2 = x[j] y2 = y[j] GraphicsWindow.DrawLine(x1, y1, x2, y2) AddDots() x1 = x2 y1 = y2 EndFor EndFor For j = 9 To n x2 = x[j] y2 = y[j] If 9 < j Then GraphicsWindow.DrawLine(x1, y1, x2, y2) AddDots() EndIf x1 = x2 y1 = y2 EndFor Sub AddDots _x = x2 - x1 _y = y2 - y1 len = Math.SquareRoot(_x * _x + _y * _y) m = Math.Floor(len / gap) If 2 <= m Then GraphicsWindow.PenWidth = 0 r = 1 / m For l = 1 To m - 1 i = i + 1 x[i] = x1 * (1 - r) + x2 * r y[i] = y1 * (1 - r) + y2 * r shp[i] = Shapes.AddEllipse(size, size) Shapes.Move(shp[i], x[i] - size / 2, y[i] - size / 2) r = r + 1 / m EndFor GraphicsWindow.PenWidth = 2 EndIf EndSub End>QLG339.sb< Start>QLM601.sb< '----------------------- ' Author: Naggingmachine ' Blog: http://naggingmachine.tistory.com ' Email: wooseok.seo@gmail.com '----------------------- '----------------------- ' Timer setup '----------------------- Timer.Interval = 50 Timer.Tick = onTimerTick '----------------------- ' Mouse setup '----------------------- GraphicsWindow.MouseMove = onMouseMove mouseX = GraphicsWindow.MouseX mouseY = GraphicsWindow.MouseY '----------------------- ' Turtle setup '----------------------- turtleX = GraphicsWindow.Width/2 turtleY = GraphicsWindow.Height/2 Turtle.X = turtleX Turtle.Y = turtleY Turtle.Show() '----------------------- ' Initialize '----------------------- GraphicsWindow.Title = "Having fun with Turtle" GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(127,127,127) GraphicsWindow.FontName="arial" GraphicsWindow.FontSize=30 GraphicsWindow.Fontbold="true" GraphicsWindow.DrawText(0, 0, "Move mouse, then the turtle will follow you.") moveHorizontal = 5 moveVerticle = 5 Sub onTimerTick ' Get the new X position of the turtle If (mouseX < turtleX) Then If (turtleX - mouseX < 5) Then turtleX = mouseX Else turtleX = turtleX - moveHorizontal EndIf ElseIf (mouseX > turtleX) Then If (mouseX - turtleX < 5) Then turtleX = mouseX Else turtleX = turtleX + moveHorizontal EndIf EndIf ' Get the new Y position of the turtle If (mouseY < turtleY) Then If (turtleY - mouseY < 5) Then turtleY = mouseY Else turtleY = turtleY - moveVerticle EndIf ElseIf (mouseY > turtleY) Then If (mouseY - turtleY < 5) Then turtleY = mouseY Else turtleY = turtleY + moveVerticle EndIf EndIf ' Move the turtle to new position Turtle.X = turtleX Turtle.Y = turtleY EndSub Sub onMouseMove mouseX = GraphicsWindow.MouseX mouseY = GraphicsWindow.MouseY EndSub End>QLM601.sb< Start>QLM846.sb< 'Turtle Maze Game Demonstration - by LitDev for January 2015 Small Basic Challenges 'Doesn't work using SliverLight online 'Includes methods that may be of general interest to: 'Manually and auto generate mazes 'Play asyncronous background music 'Turtle trail deletion '================================================== 'INITIAL SETUP '================================================== SetGW() GetMedia() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp Timer.Interval = 10 Timer.Tick = OnTick ResetGame() 'This starts the game when a key is pressed '================================================== 'MAIN GAME LOOP '================================================== While ("True") UpdateTime() CheckCompleted() CheckKeys() 'No delay to move turtle more smoothly when key held down EndWhile '================================================== 'EVENT SUBROUTINES '================================================== Sub OnKeyDown key = GraphicsWindow.LastKey keyDown[key] = "True" EndSub Sub OnKeyUp key = GraphicsWindow.LastKey keyDown[key] = "False" EndSub Sub OnTick 'See http://social.technet.microsoft.com/wiki/contents/articles/28800.how-to-add-background-music-to-a-small-basic-game.aspx 'Music repeatedly played asynchronously (on timer thread) Timer.Pause() While ("True") If (playMusic) Then Sound.PlayAndWait(backgroundMusic) EndIf Program.Delay(20) EndWhile EndSub '================================================== 'SETUP SUBROUTINES '================================================== Sub SetGW 'gw = Desktop.Width*0.75 'gh = Desktop.Height*0.75 gw = 600 gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh 'Center GW on screen GraphicsWindow.Top = (Desktop.Height-gh)/4 GraphicsWindow.Left = (Desktop.Width-gw)/2 'Loading... GraphicsWindow.BrushColor = "Purple" GraphicsWindow.FontSize = 40 GraphicsWindow.DrawText(gw/2-100,gh/3,"Loading...") 'Timing display text GraphicsWindow.FontSize = 15 GraphicsWindow.BrushColor = "Black" timing1 = Shapes.AddText("") GraphicsWindow.BrushColor = "Yellow" timing2 = Shapes.AddText("") Shapes.Move(timing1,gw-120+2,4+2) Shapes.Move(timing2,gw-120,4) 'turtleLine Count to clear them after each screen turtleLineStart = 1 turtleLine = 0 EndSub Sub GetMedia 'Images pathImage = ImageList.LoadImage("http://litdev.co.uk/game_images/pathImage.jpg") wallImage = ImageList.LoadImage("http://litdev.co.uk/game_images/wallImage.jpg") homeImage = ImageList.LoadImage("http://litdev.co.uk/game_images/homeImage.png") 'Music - internally SB creates a cached list so they are only downloaded once backgroundMusic = "http://litdev.co.uk/game_images/backgroundMusic.mp3" crashSound = "http://litdev.co.uk/game_images/crashSound.mp3" applauseSound = "http://litdev.co.uk/game_images/applauseSound.mp3" 'Basic Options playMusic = "True" level = 1 EndSub Sub DrawGrid 'Initially all path - add walls later 'GraphicsWindow.BrushColor = "White" 'GraphicsWindow.FillRectangle(0,0,gw,gh) GraphicsWindow.DrawResizedImage(pathImage,0,0,gw,gh) GraphicsWindow.Title = "Turtle Maze (Arrow Keys)" 'Get the level grid GetGrid() 'Number of rows nrow = Array.GetItemCount(grid) ncol = 0 'Max number of columns For i = 1 To nrow 'Allow for possibility of different length rows as in this maze ncol = Math.Max(ncol,Text.GetLength(grid[i])) EndFor 'width and height of a path/wall segment w = gw/ncol h = gh/nrow 'Draw grid walls For i = 1 To ncol For j = 1 To nrow loc = Text.GetSubText(grid[j],i,1) If (loc = "X" Or loc = "") Then 'Unassigned is wall 'GraphicsWindow.BrushColor = "Black" 'GraphicsWindow.FillRectangle(x,y,w+1.5,h+1.5) '+1.5 is to prevent leaving small black lines due to non integer pixels GraphicsWindow.DrawResizedImage(wallImage,(i-1)*w,(j-1)*h,w,h) ElseIf (loc = "S") Then 'Turtle start position turtleStartX = i turtleStartY = j ElseIf (loc = "E") Then 'Home (End) GraphicsWindow.DrawResizedImage(homeImage,(i-1)*w,(j-1)*h,w,h) EndIf EndFor EndFor EndSub Sub ResetGame 'Remove any previous level turtle lines ClearLines() 'Create the grid DrawGrid() 'Initial turtle position Turtle.PenUp() Turtle.Speed = 10 turtleX = turtleStartX turtleY = turtleStartY 'Turtle.MoveTo sometimes fails if we move along virtually horizontal or vertical lines (internal rounding underflow error - bug) - so we do a 2 step move Turtle.MoveTo(-100,-100) Turtle.MoveTo((turtleX-0.5)*w,(turtleY-0.5)*h) Turtle.MoveTo((turtleX-0.5)*w,(turtleY-0.5)*h) 'Also MoveTo is not very accurate on a long move so do it twice! Turtle.Angle = angleStart Turtle.Speed = 6 Turtle.PenDown() Program.Delay(100) 'Start when first key is pressed gameStart = Clock.ElapsedMilliseconds UpdateTime() turtleLineStart = turtleLine+1 keyDown = "" While (Array.ContainsValue(keyDown,"True") = "False") Program.Delay(20) EndWhile gameStart = Clock.ElapsedMilliseconds EndSub '================================================== 'GAME SUBROUTINES '================================================== Sub CheckKeys 'Move turtle if there is no barrier 'If there is a barrier do a crash noise that is also a penalty delay If (keyDown["Left"] And turtleX > 1) Then loc = Text.GetSubText(grid[turtleY],turtleX-1,1) If (loc <> "X") Then Turtle.Angle = -90 Turtle.Move(w) turtleLine = turtleLine+1 turtleX = turtleX-1 Else Sound.PlayAndWait(crashSound) EndIf ElseIf (keyDown["Right"] And turtleX < ncol) Then loc = Text.GetSubText(grid[turtleY],turtleX+1,1) If (loc <> "X") Then Turtle.Angle = 90 Turtle.Move(w) turtleLine = turtleLine+1 turtleX = turtleX+1 Else Sound.PlayAndWait(crashSound) EndIf ElseIf (keyDown["Up"] And turtleY > 1) Then loc = Text.GetSubText(grid[turtleY-1],turtleX,1) If (loc <> "X") Then Turtle.Angle = 0 Turtle.Move(h) turtleLine = turtleLine+1 turtleY = turtleY-1 Else Sound.PlayAndWait(crashSound) EndIf ElseIf (keyDown["Down"] And turtleY < nrow) Then loc = Text.GetSubText(grid[turtleY+1],turtleX,1) If (loc <> "X") Then Turtle.Angle = 180 Turtle.Move(h) turtleLine = turtleLine+1 turtleY = turtleY+1 Else Sound.PlayAndWait(crashSound) EndIf ElseIf (keyDown["OemPlus"]) Then level = level+1 ResetGame() 'Next Level Game ElseIf (keyDown["OemMinus"]) Then level = Math.Max(1,level-1) ResetGame() 'Previous Level Game ElseIf (keyDown["Space"]) Then ResetGame() 'Replay Level Game ElseIf (keyDown["Escape"]) Then Program.End() 'End Game EndIf EndSub Sub CheckCompleted 'Maze Completed loc = Text.GetSubText(grid[turtleY],turtleX,1) If (loc = "E") Then txt = "You completed Level "+level+" in "+gameTime+" seconds!" GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 23 message1 = Shapes.AddText(txt) GraphicsWindow.BrushColor = "Yellow" message2 = Shapes.AddText(txt) Shapes.Move(message1,gw/2-225+2,gh/3+2) Shapes.Move(message2,gw/2-225,gh/3) 'New level level = level+1 Sound.PlayAndWait(applauseSound) Program.Delay(5000) Shapes.Remove(message1) Shapes.Remove(message2) ResetGame() 'New Game EndIf EndSub Sub UpdateTime gameTime = Clock.ElapsedMilliseconds-gameStart gameTime = 0.1*Math.Round(gameTime/100) status = "Level "+level+" "+gameTime Shapes.SetText(timing1,status) Shapes.SetText(timing2,status) EndSub Sub ClearLines 'Turtle lines are just line shapes For i = turtleLineStart To turtleLine Shapes.Remove("_turtleLine"+i) EndFor turtleLineStart = turtleLine+1 EndSub '================================================== 'MAZE GRID GENERATION SUBROUTINES '================================================== Sub GetGrid 'Grid rows from top to bottom 'X is wall, S is start, E is End, Space is path 'The indices for gridRaw do not have to be contiguous numbers If (level = 1) Then angleStart = 180 'Initially facing down gridRaw[1] = "XSXXXXXXXXXXXXXXXXX" gridRaw[2] = "X X X" gridRaw[3] = "X X XXX X XXXXXXXXX" gridRaw[4] = "X X X X" gridRaw[5] = "X XXX XXXXXXXXX X X" gridRaw[6] = "X X X X X X" gridRaw[33] = "X XXXXX XXXXX XXX X" 'Out of sequnce index for test gridRaw[8] = "X X X X X" gridRaw[9] = "XXX X XXXXX X X X X" gridRaw[10] = "X X X X X X X X" gridRaw[11] = "XXX X X X X X X X X" gridRaw[12] = "X X X X X X X" gridRaw[13] = "X XXXXXXX XXXXXXXXX" gridRaw[14] = "X X X X" gridRaw[15] = "XXXXX X X X XXXXX X" gridRaw[16] = "X X X X X X X" gridRaw[17] = "X XXX X XXXXX X X X" gridRaw[18] = "X X X X E" gridRaw[19] = "xxxxxxxxxxxxxxxxxxx" 'Deliberate lower case x as a test Else 'Auto generated levels AutoGrid() EndIf 'Make sure grid is indexed monotonically - if we insert a row with 'out of order' index it will be sorted here 'Also convert all to upper case for condition comparisons later indices = Array.GetAllIndices(gridRaw) grid = "" 'Ensure empty to start with For i = 1 To Array.GetItemCount(indices) grid[i] = Text.ConvertToUpperCase(gridRaw[indices[i]]) EndFor gridRaw = "" 'We don't need this any more EndSub Sub AutoGrid 'Grid dimension size = 5*level If (Math.Remainder(size,2) = 0) Then 'Best with odd number of cells on sides size = size+1 EndIf 'See http://en.wikipedia.org/wiki/Maze_generation_algorithm 'Randomized Prim's algorithm 'Start with a grid full of walls. For i = 1 To size For j = 1 To size If (Math.Remainder(i,2) = 0 And Math.Remainder(j,2) = 0) Then 'i and j even then cell grid[i][j] = "cell" ElseIf (Math.Remainder(i,2) = 0 And j > 1 And j < size) Then 'horizontal wall grid[i][j] = "wall" ElseIf (Math.Remainder(j,2) = 0 And i > 1 And i < size) Then 'vertical wall grid[i][j] = "wall" Else 'Always a barrier grid[i][j] = "X" EndIf EndFor EndFor nWall = 0 'Start position grid[1][2] = "S" angleStart = 180 'Initially facing down 'Home position grid[size-1][size] = "E" 'Pick a cell, mark it as part of the maze. Add the walls of the cell to the wall list. i = 2 j = size-1 'Seeding top right gives a better grid on the opposite diagonal AddWalls() 'While there are walls in the list: While (Array.GetItemCount(walls) > 0) 'Pick a random wall from the list. indices = Array.GetAllIndices(walls) index = indices[Math.GetRandomNumber(Array.GetItemCount(indices))] wall = walls[index] 'If the cell on the opposite side isn't in the maze yet: i = wall["i"] j = wall["j"] If (Math.Remainder(i,2) = 0) Then 'Horizontal Wall If (grid[i][j-1] = "cell") Then 'Make the wall a passage grid[i][j] = " " 'Mark the cell on the opposite side as part of the maze. 'Add the neighboring walls of the cell to the wall list. j = j-1 'The cell should at i,j so modify j - we don't use it again so no problem AddWalls() ElseIf (grid[i][j+1] = "cell") Then grid[i][j] = " " j = j+1 AddWalls() EndIf ElseIf (Math.Remainder(j,2) = 0) Then 'Vertical Wall If (grid[i-1][j] = "cell") Then grid[i][j] = " " i = i-1 AddWalls() ElseIf (grid[i+1][j] = "cell") Then grid[i][j] = " " i = i+1 AddWalls() EndIf EndIf 'Remove the wall from the list. walls[index] = "" EndWhile 'Convert to gridRaw text format gridRaw = "" For i = 1 To size For j = 1 To size If (Text.GetLength(grid[i][j]) > 1) Then 'Remaining walls grid[i][j] = "X" EndIf gridRaw[i] = gridRaw[i]+grid[i][j] EndFor EndFor EndSub Sub AddWalls 'Mark the cell as part of the maze. grid[i][j] = " " 'Add the neighboring walls of the cell to the wall list. If (grid[i-1][j] = "wall") Then nWall = nWall+1 walls[nWall]["i"] = i-1 walls[nWall]["j"] = j EndIf If (grid[i+1][j] = "wall") Then nWall = nWall+1 walls[nWall]["i"] = i+1 walls[nWall]["j"] = j EndIf If (grid[i][j-1] = "wall") Then nWall = nWall+1 walls[nWall]["i"] = i walls[nWall]["j"] = j-1 EndIf If (grid[i][j+1] = "wall") Then nWall = nWall+1 walls[nWall]["i"] = i walls[nWall]["j"] = j+1 EndIf EndSub End>QLM846.sb< Start>QLN327.sb< ' Translator by NaochanON gui() Controls.ButtonClicked=onclicked Sub onclicked word= Controls.GetTextBoxText(Mbox1) w1= Controls.GetTextBoxText(_from) w2= Controls.GetTextBoxText(_to) w3=Controls.GetTextBoxText(_to2) ans=LDTranslate.Translate(word,w1,w2) ans2=LDTranslate.Translate(ans,w2,w3) Controls.SetTextBoxText(Mbox2,ans) Controls.SetTextBoxText(Mbox3,ans2) EndSub Sub gui CRLF= Text.GetCharacter(13)+Text.GetCharacter(10) GraphicsWindow.BackgroundColor="#B8D200" GraphicsWindow.Width=830 GraphicsWindow.Height=520 GraphicsWindow.BrushColor="Red" GraphicsWindow.FontSize=14 word = " Input text here " Mbox1=Controls.AddMultiLineTextBox(20,40) Controls.SetSize(Mbox1,800,130) Controls.SetTextBoxText(Mbox1,word) GraphicsWindow.BrushColor="Navy" Mbox2=Controls.AddMultiLineTextBox(20,180) Controls.SetSize(Mbox2,800,130) Mbox3=Controls.AddMultiLineTextBox(20,320) Controls.SetSize(Mbox3,800,130) Controls.AddButton("Translate",600,5) _from=Controls.AddTextBox(380,5) Controls.SetSize(_from,50,25) Controls.SetTextBoxText(_from,"de") GraphicsWindow.DrawText(433,8,"-->") _to=Controls.AddTextBox(455,5) Controls.SetSize(_to,50,25) Controls.SetTextBoxText(_to,"en") GraphicsWindow.DrawText(510,8,"-->") _to2=Controls.AddTextBox(535,5) Controls.SetSize(_to2,50,25) Controls.SetTextBoxText(_to2,"ja") Lang="ar,bs-Latn,bg,ca,zh-CHS,zh-CHT,hr,cs,da,nl,en,et,fi,fr,de,el,ht,he,hi,mww,u,id,it,a,sw,tlh, " Lang=Lang+CRLF+"jtlh-Qaak,hko,lv,lt,ms,mt,no,fa,pl,pt,otq,ro,ru,sr-Cyrl," Lang=Lang+"sr-Latn,sk,sl,es,sv,th,tr,uk,ur,vi,cy,yua " GraphicsWindow.DrawBoundText(20,455,830,Lang) EndSub End>QLN327.sb< Start>QLN492.sb< ' program : yvan leduc ' avatar generator v 2.4 ' program no: ' Not = "True=False;False=True;" GraphicsWindow.BackgroundColor="white" GraphicsWindow.Width=400 GraphicsWindow.height=400 GraphicsWindow.top=0 GraphicsWindow.left=0 GraphicsWindow.KeyDown = OnKeyDown While "True" GraphicsWindow.Clear() x=1 y=1 f1=math.GetRandomNumber(60)+10 h1=math.GetRandomNumber(100)+300 h2=math.GetRandomNumber(100)+300 For x= 1 To 400 Step f1 a=math.GetRandomNumber(50) b=math.GetRandomNumber(45) c=math.GetRandomNumber(30) d=math.GetRandomNumber(10) c1=math.GetRandomNumber(255)+a c2=math.GetRandomNumber(255)-b c3=math.GetRandomNumber(255)+c color=GraphicsWindow.GetColorFromRGB(c1,c2,c3) f2=math.GetRandomNumber(60)+10 For y= 400 To 1 Step -f2 ' random colors, random circles, random triangle, random size, GraphicsWindow.BrushColor=color GraphicsWindow.DrawTriangle(a+x,b+y,a+x,b+y,d+x,c+y) GraphicsWindow.FillTriangle(a+x,b+y,a+x,b+y,d+x,c+y) GraphicsWindow.DrawTriangle(c+x,b+y,d+x,c+y,b+x,c+y) GraphicsWindow.FillTriangle(c+x,b+y,d+x,c+y,b+x,c+y) GraphicsWindow.BrushColor=color color=GraphicsWindow.GetColorFromRGB(c1,c2,c3) GraphicsWindow.DrawRectangle(b+x,a+y,b+x,d+y) GraphicsWindow.Fillrectangle(b+x,a+y,b+x,d+y) GraphicsWindow.DrawEllipse(b*d,d*a,c1,c2) GraphicsWindow.fillEllipse(b*d,d*a,c1,c2) GraphicsWindow.DrawTriangle(c+x,b+y,d+x,c+y,b+x,c+y) GraphicsWindow.FillTriangle(c+x,b+y,d+x,c+y,b+x,c+y) EndFor endfor keyDown = "False" While Not[keyDown] Program.Delay(200) EndWhile EndWhile Sub OnKeyDown keyDown = "True" EndSub End>QLN492.sb< Start>QLN628.sb< TextWindow.WriteLine("Welcome to the number-guessing game! I will think of a number between 1 and 100,and you get to guess it!") begin: rn = Math.GetRandomNumber(100) guessing = "True" Counter = 0 While (guessing) TextWindow.Write("Please enter your guess: ") guess1 = TextWindow.ReadNumber() Counter = Counter+1 If guess1 < rn Then TextWindow.WriteLine("Sorry, you were too low, please guess again.") ElseIf guess1 > rn then TextWindow.WriteLine("Sorry, you were too high, please guess again.") Elseif guess1 = rn then TextWindow.WriteLine("You got it!!!!") guessing = "False" EndIf EndWhile TextWindow.WriteLine("Your number of guesses was " + Counter + "!") TextWindow.WriteLine("Would you like to play again? Y/N") yn1=TextWindow.Read() If yn1="Y" Or yn1="y" Then Goto begin ElseIf yn1="N" or yn1="n" then TextWindow.WriteLine("Thank you for playing!") Program.End() EndIf End>QLN628.sb< Start>QLR567.sb< offset=1 ' The following line could be harmful and has been automatically commented. ' mytext = File.ReadContents("1984.txt") TextWindow.Writeline(mytext) For i = 1 To Text.GetLength(mytext) char = Text.ConvertToLowerCase(text.GetSubText(mytext,i,1)) charval = Text.GetCharacterCode(char) if charval>96 And charval < 123 Then enccode = charval+offset If enccode>122 then enccode = 96 + (enccode - 122) EndIf enctext = enctext + Text.GetCharacter(enccode) EndIf EndFor TextWindow.WriteLine(enctext) End>QLR567.sb< Start>QLS406.sb< 'Events Controls.ButtonClicked = OnButtonClicked '****************************************************************************** '* If you make the File with the controltool you need the path and filename in DN * '* and the SUB Init. * '* Path and Filename * DN = "D:\SampleButton.arr" ' * Init() ' * '****************************************************************************** Main() ' MAINROUTINE '****************************************************************************** Sub Main 'Multi-Line-Text-Box with the construction of the controls button BTLT = Controls.AddMultiLineTextBox(10, 10) Controls.SetSize(BTLT,780,500) Controls.SetTextBoxText(BTLT, LT) Mainloop = 1 'Set Start for Mainloop While Mainloop = 1 'Begin of Mainloop ReactionControls() 'The reaction if you click a button Program.Delay(50) 'Wait for 50 msec EndWhile 'Mainloop 'End of Mainloop Program.End() 'Ending Program EndSub 'Main Sub ReactionControls If BC = 1 Then 'if button was clicked then LB = Controls.LastClickedButton 'LB is the name of the button was clicked If LB = bt[1] Then 'Was it the button Start then Controls.SetTextBoxText(BTLT, "") 'Clear the text in the MultiLineTextBox EndIf If LB = bt[2] Then 'Was it the button Load File then Controls.HideControl(BTLT) 'Hide the MultiLineTextBox 'For this you need the extention from Litdev DN = LDDialogs.OpenFile("*") 'Select the File to load ' The following line could be harmful and has been automatically commented. ' RT = File.ReadContents(DN) 'Load the File Controls.SetTextBoxText(BTLT, RT) 'Set the text in the MultiLineTextBox Controls.ShowControl(BTLT) 'Show the MultiLineTextBox EndIf If LB = bt[3] Then 'Was it the button Edit then 'For this you need the extention from Litdev LDFocus.SetFocus(BTLT) 'Set the focus in the MultiLineTextBox EndIf If LB = bt[4] Then 'Was it the button Change background color then 'For this you need the DataExtention GraphicsWindow.BackgroundColor = Dialogs.AskForColor() 'Select the color and set the backround color EndIf If LB = bt[5] Then 'Was it the button Save then RT = Controls.GetTextBoxText(BTLT) 'Put the Text from the MultiLineTextBox to RT 'For this you need the extention from Litdev DN = LDDialogs.SaveFile("*") 'Select or input the Filename in DN ' The following line could be harmful and has been automatically commented. ' ER = File.WriteContents(DN, RT) 'Write the text into the file and put the resultmessage in ER If ER = "SUCCESS" Then 'Was the resultmessage SUCCESS then Controls.SetTextBoxText(BTLT, "Save was success.") 'Set the message into the MultiLineTextBox EndIf EndIf If LB = bt[6] Then 'Was it the button Change font then 'For this you need the DataExtention Dialogs.AskForFont() 'Select Font and so on GraphicsWindow.FontName = Dialogs.LastFontName 'Set the font GraphicsWindow.FontSize = Dialogs.LastFontSize 'Set the fontsize EndIf If LB = bt[7] Then 'Was it the button Change brushcolor then 'For this you need the DataExtention GraphicsWindow.BrushColor = Dialogs.AskForColor() 'Select and set the brushcolor EndIf If LB = bt[8] Then 'Was it the button End then Mainloop = 0 'Clear the Mainloop skip for end the program EndIf EndIf BC = 0 'Clear the skip for button was clicked EndSub 'ReactionControls Sub Init M = ";" 'Set the seperator GraphicsWindow.Top = 1 GraphicsWindow.Left = 1 GraphicsWindow.Width = 800 GraphicsWindow.Height = 680 GraphicsWindow.Show() ReadIt() MakeNewArray() MakeControls() EndSub 'Init Sub ReadIt 'Read the array for declare the button ' The following line could be harmful and has been automatically commented. ' File.LastError = "" ' The following line could be harmful and has been automatically commented. ' b = File.ReadContents(DN) ' The following line could be harmful and has been automatically commented. ' FR = File.LastError If FR = "" Then LT = LT + "Lesen: OK" + Text.GetCharacter(13) Else LT = LT + "Lesen: " + FR + Text.GetCharacter(13) EndIf EndSub 'ReadIt Sub MakeNewArray 'Make a new array with the button row c = 1 LoopEnd = Array.GetItemCount(b) For i = 1 To LoopEnd R = b[i] S = 1 For j = 1 To Text.GetLength(R) If (Text.GetSubText(R, j, 1) = M) Then bb[c] = Text.GetSubText(R, S, j-S) c = c + 1 S = j + 1 EndIf EndFor EndFor EndSub 'MakeNewArray Sub MakeControls 'make the controls and show it LoopEnd = Array.GetItemCount(bb) index = 0 For i = 1 To LoopEnd If text.GetSubText(bb[i],1,2) = "C=" Then Do = "Make Button" EndIf If text.GetSubText(bb[i],1,2) = "T=" Then T = Text.GetSubTextToEnd(bb[i], 3) EndIf If text.GetSubText(bb[i],1,2) = "X=" Then X = Text.GetSubTextToEnd(bb[i], 3) EndIf If text.GetSubText(bb[i],1,2) = "Y=" Then Y = Text.GetSubTextToEnd(bb[i], 3) If Do = "Make Button" Then index = index + 1 bt[index] = Controls.AddButton(T,X,Y) LT = LT + Do + ": " + T + " X = " + X + " Y = " + Y + Text.GetCharacter(13) Do = "" T = "" X = "" Y = "" EndIf EndIf EndFor EndSub 'MakeControls Sub OnButtonClicked BC = 1 EndSub 'OnButtonClicked End>QLS406.sb< Start>QLT073.sb< Radius = 25 GraphicsWindow.BrushColor = "White" Ball = Shapes.AddEllipse(2*Radius, 2*Radius) GraphicsWindow.MouseMove = OnMouseMove Sub OnMouseMove If Mouse.IsLeftButtonDown = "True" Then Mouse.HideCursor() x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY Shapes.Move(Ball, x - Radius/2, y - Radius/2) Else Mouse.ShowCursor() EndIf EndSub End>QLT073.sb< Start>QLT472.sb< 'Window GraphicsWindow.Hide() GraphicsWindow.Width = 1000 GraphicsWindow.Height = 600 GraphicsWindow.Left = (Desktop.Width - 1000) / 2 GraphicsWindow.Top = (Desktop.Height - 674) / 2 GraphicsWindow.Title = "Graphics Challenges" GraphicsWindow.CanResize = "False" GraphicsWindow.FontBold = "False" GraphicsWindow.FontName = "Microsoft Sans Serif" GraphicsWindow.PenWidth = 1 'Variables CurrentMenu = "" MaximumResources = 15 ValueLsBar = 0 DirectionMario = "None" LeftMario = 391 TopMario = 89 RobotAngle = 0 RobotZoomLevel = .7 RobotOpacityLevel = 40 ShiftPressed = "False" ControlPressed = "False" RotateRobot = "False" HwLeft = 0 HwTop = 0 DragHelpWindow = "False" MaximumBubbles = 1000 Distance = 1200 Speed = 2200 ParticleSize = 200 CanAddEffect = "True" DropDownCbAddVe = "False" FireTop = 350 FireWidth = 1000 Flames = 250 'Colors ClrGrayBasic = GraphicsWindow.GetColorFromRGB(50, 50, 50) ClrGrayBack = GraphicsWindow.GetColorFromRGB(100, 100, 100) ClrGrayBorder = GraphicsWindow.GetColorFromRGB(150, 150, 150) ClrGrayText = GraphicsWindow.GetColorFromRGB(200, 200, 200) 'Main AddLoadingScreen() GraphicsWindow.Show() LoadImages() 'CompleteLoading Controls.SetSize(RecLsBar, 500, 10) Program.Delay(500) GraphicsWindow.Clear() AddMainMenu() 'Subroutines - Custom '******************** 'Load Images Sub LoadImages Load_ImgResources = "http://www.design.ddarsow.com/images/recover.png" GraphicsWindow.DrawResizedImage(Load_ImgResources, 400, 65, 200, 200) Load_ImgMario = ImageList.LoadImage("http://vignette4.wikia.nocookie.net/annoyingorange/images/b/b3/Super_mario.png/revision/latest?cb=20120728235111") AddProgressLsBar() Load_ImgMmBack = ImageList.LoadImage("http://orig10.deviantart.net/ca27/f/2006/321/4/e/motion_graphics_by_dulchis.jpg") AddProgressLsBar() Load_ImgBtnBack = ImageList.LoadImage("http://findicons.com/files/icons/694/longhorn_r2/256/back_button.png") AddProgressLsBar() Load_ImgRobot = ImageList.LoadImage("https://mir-s3-cdn-cf.behance.net/project_modules/disp/47e1c322329083.56310816f1004.png") AddProgressLsBar() Load_ImgMove = ImageList.LoadImage("http://icons.iconarchive.com/icons/shlyapnikova/toolbar-2/32/move-icon.png") AddProgressLsBar() Load_ImgRotate = ImageList.LoadImage("http://findicons.com/files/icons/1036/function/48/refresh.png") AddProgressLsBar() Load_ImgZoom = ImageList.LoadImage("http://findicons.com/files/icons/2321/plastic_xp_general/128/zoom.png") AddProgressLsBar() Load_ImgEye = ImageList.LoadImage("https://upload.wikimedia.org/wikipedia/commons/b/b1/Farm-Fresh_eye.png") AddProgressLsBar() Load_ImgBtnHelp = ImageList.LoadImage("https://en.opensuse.org/images/thumb/5/57/Icon-question.png/40px-Icon-question.png") AddProgressLsBar() Load_ImgBtnExit = ImageList.LoadImage("https://upload.wikimedia.org/wikipedia/commons/thumb/0/0c/Crystal_Clear_action_exit.png/40px-Crystal_Clear_action_exit.png") AddProgressLsBar() Load_ImgClose = ImageList.LoadImage("https://cdn4.iconfinder.com/data/icons/32x32-free-design-icons/32/Close.png") AddProgressLsBar() Load_ImgBulletPoint = ImageList.LoadImage("http://www.iconki.com/icons/Software-Applications/Good-24x24/bullet_ball_glass_blue.png") AddProgressLsBar() Load_ImgBtnOk = ImageList.LoadImage("http://wiki.thedarkmod.com/images/archive/7/75/20071111182411!Button_ok.png") AddProgressLsBar() Load_ImgGrass = ImageList.LoadImage("http://1.bp.blogspot.com/-YzHacJervsA/TxhuiS8HugI/AAAAAAAAA6Q/EKG9OoknNuo/s200/felt+grass+tile.jpg") AddProgressLsBar() Load_ImgSoil = ImageList.LoadImage("http://static.wixstatic.com/media/e967e4_e3d6344e5077452f90a9dcc6fdc2d7ee.jpg_256") AddProgressLsBar() EndSub 'AddLoadingScreen Sub AddLoadingScreen CurrentMenu = "LoadingScreen" GraphicsWindow.PenColor = ClrGrayBorder GraphicsWindow.BrushColor = ClrGrayBack RecLsTitleBack = Shapes.AddRectangle(350, 35) Shapes.Move(RecLsTitleBack, 325, 350) GraphicsWindow.BrushColor = ClrGrayText LblLsTitle = Shapes.AddText("Loading resources") Shapes.Move(LblLsTitle, 450, 360) GraphicsWindow.BackgroundColor = ClrGrayBasic GraphicsWindow.BrushColor = "Black" RecLsBarBack = Shapes.AddRectangle(500, 10) Shapes.Move(RecLsBarBack, 250, 450) GraphicsWindow.BrushColor = "LawnGreen" RecLsBar = Shapes.AddRectangle(0, 10) Shapes.Move(RecLsBar, 250, 450) EndSub 'AddProgressLsBar Sub AddProgressLsBar ValueLsBar = ValueLsBar + (500 / MaximumResources) Controls.SetSize(RecLsBar, ValueLsBar, 10) EndSub 'AddMainMenu Sub AddMainMenu CurrentMenu = "MainMenu" GraphicsWindow.BackgroundColor = ClrGrayBasic GraphicsWindow.DrawResizedImage(Load_ImgMmBack, 0, 0, 1000, 600) GraphicsWindow.PenColor = ClrGrayBorder GraphicsWindow.BrushColor = ClrGrayBack RecMmTitleBack = Shapes.AddRectangle(350, 35) Shapes.Move(RecMmTitleBack, 325, 150) RecMmBtnBack = Shapes.AddRectangle(300, 270) Shapes.Move(RecMmBtnBack, 350, 184) Shapes.SetOpacity(RecMmBtnBack, 50) GraphicsWindow.PenColor = ClrGrayBorder GraphicsWindow.BrushColor = ClrGrayText LblMmTitle = Shapes.AddText("Select a program") Shapes.Move(LblMmTitle, 450, 160) GraphicsWindow.BrushColor = "Black" CaptionsBtnMm = "1=Move image with keys;2=Move image with mouse;3=Moving river;4=Visual effects;" For Times = 1 To 4 BtnMainMenu[Times] = Controls.AddButton("", 400, 190 + Times * 45) Controls.SetSize(BtnMainMenu[Times], 200, 30) Controls.SetButtonCaption(BtnMainMenu[Times], CaptionsBtnMm[Times]) EndFor EffectFadeMm = Shapes.AddRectangle(1000, 600) Shapes.SetOpacity(EffectFadeMm, 0) Shapes.HideShape(EffectFadeMm) ImgExit = Shapes.AddImage(Load_ImgBtnExit) Shapes.Move(ImgExit, 480, 500) BtnExit = Controls.AddButton("", 480, 500) Controls.SetSize(BtnExit, 40, 40) Shapes.SetOpacity(BtnExit, 0) EndSub 'LoadMoveImgWithKeysSoft Sub LoadMoveImgWithKeysSoft CurrentMenu = "ImgKeys" ImportBackBtn() LeftMario = 391 TopMario = 89 ImgMario = Shapes.AddImage(Load_ImgMario) Shapes.Move(ImgMario, LeftMario, TopMario) GraphicsWindow.BrushColor = ClrGrayText GraphicsWindow.DrawText(10, 580, "Press the Spacebar to reset Mario's position") EndSub 'LoadMoveImgWithMouseSoft Sub LoadMoveImgWithMouseSoft CurrentMenu = "ImgMouse" ResetRobotSettings() ImportBackBtn() ImgRobot = Shapes.AddImage(Load_ImgRobot) Shapes.Move(ImgRobot, 200, 80) Shapes.SetOpacity(ImgRobot, RobotOpacityLevel) Shapes.Zoom(ImgRobot, .7, .7) GraphicsWindow.BrushColor = ClrGrayText LblRobotCoo = Shapes.AddText("") Shapes.Move(LblRobotCoo, 10, 560) LblInfoImgMouse = Shapes.AddText("Press the Spacebar to reset the image settings") Shapes.Move(LblInfoImgMouse, 10, 580) UpdateLblRobotCoo() GraphicsWindow.BrushColor = "Black" BtnHelp = Controls.AddButton("", 70, 10) Controls.SetSize(BtnHelp, 40, 40) Shapes.SetOpacity(BtnHelp, 0) GraphicsWindow.BrushColor = ClrGrayBorder GraphicsWindow.FillRectangle(60, 10, 1, 45) GraphicsWindow.DrawImage(Load_ImgBtnHelp, 70, 12) ImportCursors() EndSub 'UpdateLblRobotCoo Sub UpdateLblRobotCoo Shapes.SetText(LblRobotCoo, "Left: " + Shapes.GetLeft(ImgRobot) + " Right: " + Shapes.GetTop(ImgRobot)) EndSub 'ImportCursors Sub ImportCursors ImgMove = Shapes.AddImage(Load_ImgMove) ImgRotate = Shapes.AddImage(Load_ImgRotate) ImgZoom = Shapes.AddImage(Load_ImgZoom) ImgEye = Shapes.AddImage(Load_ImgEye) Shapes.HideShape(ImgMove) Shapes.HideShape(ImgRotate) Shapes.HideShape(ImgZoom) Shapes.HideShape(ImgEye) Controls.SetSize(ImgZoom, 48, 48) EndSub 'ResetRobotSettings Sub ResetRobotSettings RobotAngle = 0 RobotZoomLevel = .7 RobotOpacityLevel = 40 Shapes.Move(ImgRobot, 200, 80) Shapes.Rotate(ImgRobot, RobotAngle) Shapes.SetOpacity(ImgRobot, RobotOpacityLevel) Shapes.Zoom(ImgRobot, RobotZoomLevel, RobotZoomLevel) UpdateLblRobotCoo() EndSub 'LoadHelpWindow Sub LoadHelpWindow CurrentMenu = "HelpWindow" GraphicsWindow.BrushColor = "DodgerBlue" GraphicsWindow.PenColor = "DarkGray" RecHwOutter = Shapes.AddRectangle(600, 400) GraphicsWindow.BrushColor = ClrGrayBack GraphicsWindow.PenColor = "Gray" RecHwInner = Shapes.AddRectangle(584, 362) IconHelp = Shapes.AddImage(Load_ImgBtnHelp) Controls.SetSize(IconHelp, 20, 20) IconClose = Shapes.AddImage(Load_ImgClose) Controls.SetSize(IconClose, 25, 25) BtnClose = Controls.AddButton("", 567, 3) Controls.SetSize(BtnClose, 24, 24) Shapes.SetOpacity(BtnClose, 0) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 14 LblHwTitle = Shapes.AddText("Instructions") GraphicsWindow.FontSize = 12 GraphicsWindow.BrushColor = ClrGrayText CaptionsLblHl = "1=Click the image with the left mouse button and then drag it.;2=Click the image with the right mouse button and hold it to perform a rotation.;3=While hodling down the left Shift key, move the mouse up or down to zoom the image.;4=Hold down the left Control key and move the mouse up or down to change the opacity of the image.;" For Times = 1 To 4 BulletPoint[Times] = Shapes.AddImage(Load_ImgBulletPoint) LblHelpLine[Times] = Shapes.AddText(CaptionsLblHl[Times]) EndFor ImgBtnOk = Shapes.AddImage(Load_ImgBtnOk) BtnOk = Controls.AddButton("", 465, 285) Controls.SetSize(BtnOk, 71, 30) Shapes.SetOpacity(BtnOk, 0) EndSub 'UpdateHelpWindowPos Sub UpdateHelpWindowPos Shapes.Move(RecHwOutter, HwLeft, HwTop) Shapes.Move(RecHwInner, HwLeft + 8, HwTop + 30) Shapes.Move(IconHelp, HwLeft + 7, HwTop + 5) Shapes.Move(IconClose, HwLeft + 567, HwTop + 3) Shapes.Move(LblHwTitle, HwLeft + 270, HwTop + 8) Shapes.Move(BtnClose, HwLeft + 567, HwTop + 3) For Times = 1 To 4 Shapes.Move(BulletPoint[Times], HwLeft + 30, HwTop + Times * 50) Shapes.Move(LblHelpLine[Times], HwLeft + 55, 5 + HwTop + Times * 50) EndFor Shapes.Move(ImgBtnOk, HwLeft + 260, HwTop + 320) Controls.Move(BtnOk, HwLeft + 260, HwTop + 320) EndSub 'CloseHelpWindow Sub CloseHelpWindow Sound.PlayClick() Shapes.HideShape(RecHwOutter) Shapes.HideShape(RecHwInner) Shapes.HideShape(LblHwTitle) Shapes.HideShape(IconClose) Shapes.HideShape(IconHelp) Controls.HideControl(BtnClose) For Times = 1 To 4 Shapes.HideShape(BulletPoint[Times]) Shapes.HideShape(LblHelpLine[Times]) EndFor Controls.HideControl(BtnClose) Shapes.HideShape(ImgBtnOk) CurrentMenu = "ImgMouse" EndSub 'LoadRiverSoft Sub LoadRiverSoft CurrentMenu = "River" GraphicsWindow.BrushColor = "Black" BtnAddRiver = Controls.AddButton("Add river", 65, 18) Controls.SetSize(BtnAddRiver, 100, 25) ImportBackBtn() EndSub 'AddRiver Sub AddRiver CurrentMenu = "AddRiver" For Times = 1 To 7 For Loop = 1 To 4 GraphicsWindow.DrawImage(Load_ImgGrass, Times * 157 - 157, (Loop * 157) - 157) EndFor EndFor For Times = 1 To 5 GraphicsWindow.DrawImage(Load_ImgSoil, Times * 256 - 256, 150) EndFor ImportBackBtn() For Times = 1 To MaximumBubbles If CurrentMenu = "AddRiver" Then GraphicsWindow.PenColor = "DodgerBlue" GraphicsWindow.BrushColor = "DodgerBlue" Bubble[Times] = Shapes.AddEllipse(ParticleSize, 25) GraphicsWindow.PenColor = "PowderBlue" GraphicsWindow.BrushColor = "PowderBlue" Bubble2[Times] = Shapes.AddEllipse(ParticleSize, 25) GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(230, 230, 230) GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(230, 230, 230) Water[Times] = Shapes.AddEllipse(ParticleSize, 25) Shapes.HideShape(Bubble[Times]) Shapes.HideShape(Bubble2[Times]) Shapes.HideShape(Water[Times]) EndIf EndFor For Times = 1 To MaximumBubbles If CurrentMenu = "AddRiver" Then RandomYPos0 = Math.GetRandomNumber(185) RandomYPos1 = Math.GetRandomNumber(185) RandomYPos2 = Math.GetRandomNumber(185) RandomYPos3 = Math.GetRandomNumber(185) Shapes.ShowShape(Bubble[Times]) Shapes.ShowShape(Bubble2[Times]) Shapes.ShowShape(Water[Times]) Shapes.Move(Bubble[Times], -250, RandomYPos0 + 150) Shapes.Move(Bubble2[Times], -250, RandomYPos0 + 150) Shapes.Move(Water[Times], -250, RandomYPos0 + 150) Shapes.Animate(Bubble[Times], Distance, RandomYPos1 + 150, Speed) Shapes.Animate(Bubble2[Times], Distance, RandomYPos2 + 150, Speed) Shapes.Animate(Water[Times], Distance, RandomYPos3 + 150, Speed) EndIf EndFor Controls.SetButtonCaption(BtnAddRiver, "Add river") EndSub 'LoadVisualEffectsSoft Sub LoadVisualEffectsSoft CurrentMenu = "VisualEffects" ImportBackBtn() GraphicsWindow.BrushColor = "Black" CbAddVisualEffect = Controls.AddTextBox(65, 23) CbBtnAddVe = Controls.AddButton("▼", 225, 22) Controls.SetSize(CbBtnAddVe, 25, 22) BtnAddSmoke = Controls.AddButton("Smoke", 65, 45) Controls.SetSize(BtnAddSmoke, 185, 25) Controls.HideControl(BtnAddSmoke) BtnAddFire = Controls.AddButton("Fire", 65, 70) Controls.SetSize(BtnAddFire, 185, 25) Controls.HideControl(BtnAddFire) BtnCancelVe = Controls.AddButton("Cancel", 65, 18) Controls.SetSize(BtnCancelVe, 100, 25) Controls.HideControl(BtnCancelVe) EndSub 'AddVisualEffect Sub AddVisualEffect Controls.ShowControl(BtnCancelVe) CurrentEffect = Controls.GetTextBoxText(CbAddVisualEffect) If CurrentEffect = "Smoke" Then GraphicsWindow.BackgroundColor = "DodgerBlue" GraphicsWindow.PenColor = "Gray" GraphicsWindow.BrushColor = "Gray" For Loop = 1 To 20 For Times = 1 To 400 If CanAddEffect = "True" Then RandomPosX = Math.GetRandomNumber(50) RandomPosY = Math.GetRandomNumber(50) RandomPosX2 = Math.GetRandomNumber(150) RandomOpacity = Math.GetRandomNumber(100) RandomZoom = Math.GetRandomNumber(90) RandomColor = Math.GetRandomNumber(30) GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(RandomColor + 160, RandomColor + 160 , RandomColor + 160) GraphicsWindow.PenColor = GraphicsWindow.BrushColor ParticleSmoke[Times] = Shapes.AddEllipse(50, 50) Shapes.SetOpacity(ParticleSmoke[Times], RandomOpacity + 10) Shapes.Zoom(ParticleSmoke[Times], RandomZoom / 100, RandomZoom / 100) Shapes.Move(ParticleSmoke[Times], RandomPosX + 350, RandomPosY + 550) Shapes.Animate(ParticleSmoke[Times], RandomPosX2 + 400, -50, 20000) EndIf EndFor EndFor ElseIf CurrentEffect = "Fire" Then GraphicsWindow.BackgroundColor = ClrGrayBasic For Times = 1 To Flames GraphicsWindow.PenColor = "Red" GraphicsWindow.BrushColor = "Red" RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(50) RandomWidth = Math.GetRandomNumber(20) FireRed[Times] = Shapes.AddEllipse(RandomWidth, 150) Shapes.Move(FireRed[Times], RandomPosX, FireTop + RandomPosY) EndFor For Times = 1 To Flames GraphicsWindow.PenColor = "Orange" GraphicsWindow.BrushColor = "Orange" RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(50) RandomWidth = Math.GetRandomNumber(15) FireOrange[Times] = Shapes.AddEllipse(RandomWidth, 150) Shapes.Move(FireOrange[Times], RandomPosX, FireTop + RandomPosY + 40) EndFor For Times = 1 To Flames GraphicsWindow.PenColor = "Yellow" GraphicsWindow.BrushColor = "Yellow" RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(50) RandomWidth = Math.GetRandomNumber(15) FireYellow[Times] = Shapes.AddEllipse(RandomWidth, 150) Shapes.Move(FireYellow[Times], RandomPosX, FireTop + RandomPosY + 80) EndFor For Times = 1 To Flames GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(50) RandomWidth = Math.GetRandomNumber(15) FireWhite[Times] = Shapes.AddEllipse(RandomWidth, 150) Shapes.Move(FireWhite[Times], RandomPosX, FireTop + RandomPosY + 130) EndFor For Loop = 1 To 3000 If CanAddEffect = "True" Then Program.Delay(75) For Times = 1 To Flames RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(80) Shapes.Move(FireRed[Times], RandomPosX, FireTop + RandomPosY) EndFor For Times = 1 To Flames RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(80) Shapes.Move(FireOrange[Times], RandomPosX, FireTop + RandomPosY + 40) EndFor For Times = 1 To Flames RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(80) Shapes.Move(FireYellow[Times], RandomPosX, FireTop + RandomPosY + 80) EndFor For Times = 1 To Flames RandomPosX = Math.GetRandomNumber(FireWidth) RandomPosY = Math.GetRandomNumber(80) Shapes.Move(FireWhite[Times], RandomPosX, FireTop + RandomPosY + 130) EndFor EndIf EndFor EndIf EndSub 'PrepareForVisualEffect Sub PrepareForVisualEffect Controls.HideControl(BtnAddSmoke) Controls.HideControl(BtnAddFire) Controls.HideControl(CbAddVisualEffect) Controls.HideControl(CbBtnAddVe) CanAddEffect = "True" EndSub 'ImportBackBtn Sub ImportBackBtn GraphicsWindow.DrawResizedImage(Load_ImgBtnBack, 10, 10, 40, 40) BtnBack = Controls.AddButton("", 10, 10) Controls.SetSize(BtnBack, 40, 40) Shapes.SetOpacity(BtnBack, 0) EndSub 'Subroutines - System '******************** 'ButtonClicked Controls.ButtonClicked = ButtonClicked Sub ButtonClicked LastBtn = Controls.LastClickedButton If LastBtn = BtnMainMenu[1] Then GraphicsWindow.Clear() LoadMoveImgWithKeysSoft() ElseIf LastBtn = BtnMainMenu[2] Then GraphicsWindow.Clear() LoadMoveImgWithMouseSoft() ElseIf LastBtn = BtnMainMenu[3] Then GraphicsWindow.Clear() LoadRiverSoft() ElseIf LastBtn = BtnMainMenu[4] Then GraphicsWindow.Clear() LoadVisualEffectsSoft() ElseIf LastBtn = BtnBack Then If CurrentMenu = "HelpWindow" Then ElseIf CurrentMenu = "VisualEffects" Then CanAddEffect = "False" CurrentEffect = "None" GraphicsWindow.Clear() AddMainMenu() Else GraphicsWindow.Clear() AddMainMenu() EndIf ElseIf LastBtn = BtnExit Then Program.End() ElseIf LastBtn = BtnHelp Then If CurrentMenu = "HelpWindow" Then Else LoadHelpWindow() HwLeft = 200 HwTop = 100 UpdateHelpWindowPos() EndIf ElseIf LastBtn = BtnClose Or LastBtn = BtnOk Then CloseHelpWindow() ElseIf LastBtn = BtnAddRiver Then If Controls.GetButtonCaption(BtnAddRiver) = "Add river" Then Controls.SetButtonCaption(BtnAddRiver, "Cancel") AddRiver() Else CurrentMenu = "River" Controls.SetButtonCaption(BtnAddRiver, "Add river") EndIf ElseIf LastBtn = CbBtnAddVe Then If DropDownCbAddVe = "False" Then Controls.ShowControl(BtnAddSmoke) Controls.ShowControl(BtnAddFire) DropDownCbAddVe = "True" Controls.SetButtonCaption(CbBtnAddVe, "▲") Else Controls.HideControl(BtnAddSmoke) Controls.HideControl(BtnAddFire) DropDownCbAddVe = "False" Controls.SetButtonCaption(CbBtnAddVe, "▼") EndIf ElseIf LastBtn = BtnAddSmoke Then PrepareForVisualEffect() Controls.SetTextBoxText(CbAddVisualEffect, "Smoke") AddVisualEffect() ElseIf LastBtn = BtnAddFire Then PrepareForVisualEffect() Controls.SetTextBoxText(CbAddVisualEffect, "Fire") AddVisualEffect() ElseIf LastBtn = BtnCancelVe Then CanAddEffect = "False" CurrentEffect = "None" GraphicsWindow.Clear() LoadVisualEffectsSoft() EndIf EndSub 'MouseDown GraphicsWindow.MouseDown = MouseDown Sub MouseDown Mx = GraphicsWindow.MouseX My = GraphicsWindow.MouseY If CurrentMenu = "ImgMouse" Then LeftPosRobot = Shapes.GetLeft(ImgRobot) TopPosRobot = Shapes.GetTop(ImgRobot) WidthRobot = ImageList.GetWidthOfImage(Load_ImgRobot) HeightRobot = ImageList.GetHeightOfImage(Load_ImgRobot) If Mx > LeftPosRobot And Mx < LeftPosRobot + WidthRobot And My > TopPosRobot And My < TopPosRobot + HeightRobot Then If ShiftPressed = "False" And ControlPressed = "False" And RotateRobot = "False" Then If Mouse.IsLeftButtonDown Then Shapes.SetOpacity(ImgRobot, 100) Shapes.Zoom(ImgRobot, RobotZoomLevel + 0.3, RobotZoomLevel + 0.3) Shapes.Move(ImgRobot, Mx - (WidthRobot / 2) - 60, My - (HeightRobot / 2) + 25) Mouse.HideCursor() Shapes.ShowShape(ImgMove) DragRobot = "True" EndIf ElseIf ShiftPressed = "True" And Mouse.IsLeftButtonDown Then ZoomRobot = "True" Mouse.HideCursor() Shapes.ShowShape(ImgZoom) ElseIf ControlPressed = "True" And Mouse.IsLeftButtonDown Then FadeRobot = "True" Mouse.HideCursor() Shapes.ShowShape(ImgMove) Shapes.ShowShape(ImgEye) EndIf If Mouse.IsRightButtonDown And ShiftPressed = "False" And ControlPressed = "False" And DragRobot = "False" Then RotateRobot = "True" Shapes.Zoom(ImgRobot, RobotZoomLevel + 0.3, RobotZoomLevel + 0.3) Shapes.SetOpacity(ImgRobot, 100) Mouse.HideCursor() Shapes.ShowShape(ImgRotate) While RotateRobot = "True" Shapes.Rotate(ImgRobot, RobotAngle) RobotAngle = RobotAngle + 0.003 EndWhile EndIf EndIf ElseIf CurrentMenu = "HelpWindow" Then HwLeftPos = Shapes.GetLeft(RecHwOutter) HwTopPos = Shapes.GetTop(RecHwOutter) HwWidth = 600 HwHeight = 400 If Mx > HwLeftPos And Mx < HwLeftPos + HwWidth And My > HwTopPos And My < HwTopPos + 30 Then DragHelpWindow = "True" EndIf EndIf EndSub 'MouseMove GraphicsWindow.MouseMove = MouseMove Sub MouseMove Mx = GraphicsWindow.MouseX My = GraphicsWindow.MouseY If CurrentMenu = "ImgMouse" Then Shapes.Move(ImgMove, Mx - 16, My - 16) Shapes.Move(ImgRotate, Mx - 24, My - 24) Shapes.Move(ImgZoom, Mx - 24, My - 24) Shapes.Move(ImgEye, Mx - 16, My - 16) If DragRobot = "True" Then Shapes.Move(ImgRobot, Mx - (WidthRobot / 2) - 60, My - (HeightRobot / 2) + 25) UpdateLblRobotCoo() ElseIf ZoomRobot = "True" Then PrevMy = GraphicsWindow.MouseY If PrevMy > NewMy Then RobotZoomLevel = RobotZoomLevel + 0.01 ElseIf PrevMy < NewMy Then RobotZoomLevel = RobotZoomLevel - 0.01 EndIf Shapes.Zoom(ImgRobot, RobotZoomLevel, RobotZoomLevel) NewMy = GraphicsWindow.MouseY ElseIf FadeRobot = "True" Then RobotOpacityLevel = My / 6 Shapes.SetOpacity(ImgRobot, RobotOpacityLevel) EndIf ElseIf CurrentMenu = "MainMenu" Then If Mx > 480 And Mx < 520 And My > 500 And My < 540 Then If Shapes.GetOpacity(EffectFadeMm) = 0 Then Shapes.ShowShape(EffectFadeMm) For Times = 0 To 65 Step 0.01 Shapes.SetOpacity(EffectFadeMm, Times) EndFor EndIf Else If Shapes.GetOpacity(EffectFadeMm) = 65 Then For Times = 65 To 0 Step -0.01 Shapes.SetOpacity(EffectFadeMm, Times) EndFor Shapes.HideShape(EffectFadeMm) EndIf EndIf EndIf If CurrentMenu = "HelpWindow" Then If DragHelpWindow = "True" Then HwLeft = Mx - 300 HwTop = My - 15 UpdateHelpWindowPos() EndIf EndIf EndSub 'MouseUp GraphicsWindow.MouseUp = MouseUp Sub MouseUp If CurrentMenu = "ImgMouse" Then Shapes.SetOpacity(ImgRobot, RobotOpacityLevel) Shapes.Zoom(ImgRobot, RobotZoomLevel, RobotZoomLevel) Shapes.HideShape(ImgMove) Shapes.HideShape(ImgRotate) Shapes.HideShape(ImgZoom) Shapes.HideShape(ImgEye) Mouse.ShowCursor() DragRobot = "False" RotateRobot = "False" ZoomRobot = "False" ShiftPressed = "False" FadeRobot = "False" ControlPressed = "False" ElseIf CurrentMenu = "HelpWindow" Then DragHelpWindow = "False" EndIf EndSub 'KeyDown GraphicsWindow.KeyDown = KeyDown Sub KeyDown LastKey = GraphicsWindow.LastKey If CurrentMenu = "ImgKeys" Then If LastKey = "Right" Then DirectionMario = "Right" ElseIf LastKey = "Left" Then DirectionMario = "Left" ElseIf LastKey = "Up" Then DirectionMario = "Up" ElseIf LastKey = "Down" Then DirectionMario = "Down" EndIf If LastKey = "Space" Then Shapes.Move(ImgMario, 391, 89) LeftMario = 391 TopMario = 89 EndIf Timer.Resume() ElseIf CurrentMenu = "ImgMouse" Then If LastKey = "LeftShift" Then ShiftPressed = "True" ElseIf LastKey = "LeftCtrl" Then ControlPressed = "True" ElseIf LastKey = "Space" Then ResetRobotSettings() EndIf EndIf EndSub 'KeyUp GraphicsWindow.KeyUp = KeyUp Sub KeyUp Timer.Pause() DirectionMario = "None" ShiftPressed = "False" ControlPressed = "False" EndSub 'TextTyped Controls.TextTyped = TextTyped Sub TextTyped If CurrentMenu = "VisualEffects" Then TxtVeInput = Controls.GetTextBoxText(CbAddVisualEffect) Controls.HideControl(BtnAddSmoke) Controls.HideControl(BtnAddFire) DropDownCbAddVe = "False" Controls.SetButtonCaption(CbBtnAddVe, "▼") If TxtVeInput = "Smoke" Or TxtVeInput = "Fire" Then PrepareForVisualEffect() CanAddEffect = "True" AddVisualEffect() EndIf EndIf EndSub 'Timer Timer.Interval = 0.1 Timer.Tick = MoveMario Sub MoveMario If DirectionMario = "Right" Then LeftMario = LeftMario + 8 ElseIf DirectionMario = "Left" Then LeftMario = LeftMario - 8 ElseIf DirectionMario = "Up" Then TopMario = TopMario - 8 ElseIf DirectionMario = "Down" Then TopMario = TopMario + 8 EndIf Shapes.Move(ImgMario, LeftMario, TopMario) EndSub End>QLT472.sb< Start>QLT687.sb< GraphicsWindow.BackgroundColor="midnightblue dw=desktop.Width dh=desktop.Height GraphicsWindow.width=dw GraphicsWindow.Height=dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title="4 Towers & Drone view3D = LD3DView.AddView(dw,dh,"True") LD3DView.AddAmbientLight(view3D "#22555555") LD3DView.AddSpotLight (view3D,"white",1 1 1, -1,-1,1 30, 10) LD3DView.AddDirectionalLight (view3D,"white" ,-1,-1,-1) LD3DView.AutoControl2 (1 1) LD3DView.ResetCamera(view3D 0 0 50 0 0, -1 "" "" "") coll[2]="1=white;0=blue coll[3]="1=red;0=darkcyan coll[4]="1=yellow;0=green coll[1]="1=black;0=gray cp[0]=LDText.Split("0 0 0 0 0 0 0 0 0 0 0 0" " ") cp[1]=LDText.Split("0 1 0 0 0 1 0 0 0 1 0 0" " ") cp[2]=LDText.Split("1 1 1 0 1 1 1 0 1 1 1 0" " ") cp[3]=LDText.Split("0 1 0 0 0 1 0 0 0 1 0 0" " ") For mx=0 To 1 For my=0 To 1 ci=ci+1 col=coll[ci] If ci=1 Then s1=0 Else s1=0 'speed up redraw by increasing tower baseheight e.g. set to 11 EndIf For z=s1 To 20 If Math.Remainder(z 4)=0 Then ofs=2-ofs EndIf For x=0 To 10 For y=0 To 10 If y=0 and z>5 and z<10 and x>=3 and x<=7 Then ElseIf y=10 and z<10 and x>=3 and x<=7 Then ElseIf x=0 and z>10 and z<15 and y>=3 and y<=7 Then ElseIf x=10 and z>10 and z<15 and y>=3 and y<=7 Then ElseIf z=20 and Math.Remainder(x 2)=1 Then ElseIf x=0 or x=10 or y=0 or y=10 or z=19 Then cll=col[cp[Math.Remainder(z 4)][math.Remainder( x+ofs 12)+1]] cc=LD3DView.AddCube(view3D 1 cll "D") LD3DView.TranslateGeometry(view3D cc x-mx*50 y+my*50 z) EndIf EndFor EndFor EndFor EndFor EndFor drnn() While 1=1 dz=180 For a=0 To 270*4 Step 4 dz=dz+1 zz=zz+1 dzz=LDMath.Sin(zz)*6+10 ppx=LDMath.Cos(dz)*25 ppy=LDMath.Sin(dz)*25 ' GraphicsWindow.Title=dz LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor dz=-90 For a=0 To 360*4 Step 4 dz=dz-1 zz=zz+1 ' GraphicsWindow.Title=dz dzz=LDMath.Sin(Zz)*6+10 ppx=LDMath.Cos(dz)*25 ppy=LDMath.Sin(dz)*25+50 LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor dz=90 For a=0 To 90*4 Step 4 dz=dz+1 zz=zz+1 dzz=LDMath.Sin(zz)*6+10 ppx=LDMath.Cos(dz)*25 ppy=LDMath.Sin(dz)*25 ' GraphicsWindow.Title=dz LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor dz=360 For a=0 To 270*4 Step 4 dz=dz-1 ' GraphicsWindow.Title=dz dzz=LDMath.Sin(zz)*6+10 ppx=LDMath.Cos(dz)*25-50 ppy=LDMath.Sin(dz)*25 LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor dz=-90 For a=0 To 360*4 Step 4 dz=dz+1 zz=zz+1 ' GraphicsWindow.Title=dz dzz=LDMath.Sin(Zz)*6+10 ppx=LDMath.Cos(dz)*25-50 ppy=LDMath.Sin(dz)*25+50 LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor dz=90 For a=0 To 90*4 Step 4 dz=dz-1 zz=zz+1 dzz=LDMath.Sin(zz)*6+10 ppx=LDMath.Cos(dz)*25-50 ppy=LDMath.Sin(dz)*25 ' GraphicsWindow.Title=dz LD3DView.RotateGeometry(view3D o1 0 0 1 a) LD3DView.RotateGeometry(view3D o11 0 0 1, -a) LD3DView.RotateGeometry(view3D o31 0 0 1 a) LD3DView.RotateGeometry(view3D o21 0 0 1, -a) LD3DView.TranslateGeometry(view3D o1 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o11 5+ppx ppy dzz) LD3DView.TranslateGeometry(view3D o21 ppx ppy dzz) LD3DView.TranslateGeometry(view3D o31 5+ppx ppy dzz) For f=1 To 4 LD3DView.TranslateGeometry(view3D b1[f] px[f]+ppx ppy+py[f] dzz) EndFor Program.Delay(2) EndFor EndWhile Sub drnn clrz=LDText.Split("red lime lightblue cyan magenta yellow tan orange gray teal brown black" " ") ss=":" ix=0 For n=1 To 61 pt=pt+LDMath.Sin(n*6)*3+ss+LDMath.cos(n*6)*3+ss+"0"+ss EndFor For x=0 To 1 For y=0 To 1 ix=ix+1 b1[ix]=LD3DView.AddTube(view3D,pt .5 10 clrz[1],"D") LD3DView.TranslateGeometry(view3D b1[ix] x*7 y*7 0) px[ix]=x*7 py[ix]=y*7 EndFor EndFor o1=LD3DView.AddTube(view3D,"-2:0:0 2:0:0" .5 10 clrz[2],"D") o11=LD3DView.AddTube(view3D,"0:0:0 4:0:0" .5 10 clrz[2],"D") LD3DView.TranslateGeometry(view3D o11 5 0 0) LD3DView.SetCentre(view3D o11 2 0 0 "R1R2R3") o21=LD3DView.AddTube(view3D,"-2:7:0 2:7:0" .5 10 clrz[2],"D") o31=LD3DView.AddTube(view3D,"0:7:0 4:7:0" .5 10 clrz[2],"D") LD3DView.TranslateGeometry(view3D o31 5 0 0) LD3DView.SetCentre(view3D o31 2 7 0 "R1R2R3") EndSub End>QLT687.sb< Start>QLV088.sb< GraphicsWindow.BackgroundColor ="teal GraphicsWindow.PenWidth =1 GraphicsWindow.Top=5 GraphicsWindow.Height =900 GraphicsWindow.Width=750 LDScrollBars .Add(700 2000) f100=55 GraphicsWindow.Title="Color Picker GraphicsWindow.MouseMove=mmm For h=0 to 1 hh=h/2 zz=0 For z =1 To .05 Step -.05 y=0 zz=zz+1 For yy=1-hh To .5-hh Step -.05 If Math.Remainder (zz 2)=1-h then zzz=y*5+(zz-1)*f100 Else zzz=zz*f100-y*5-5 endif y=y+1 For x=0 To 359 cc= LDColours.HSLtoRGB (x z yy) GraphicsWindow.PenColor=cc If h=0 Then GraphicsWindow.DrawLine (370-x-h*360 31+zzz 370-x-h*360 36+zzz) else GraphicsWindow.DrawLine (11+x+h*360 31+zzz 11+x+h*360 36+zzz) endif EndFor endfor EndFor endfor Sub mmm cc= GraphicsWindow.GetPixel (GraphicsWindow.MouseX GraphicsWindow.MouseY ) GraphicsWindow.BackgroundColor=cc GraphicsWindow.Title=cc EndSub End>QLV088.sb< Start>QMD035-0.sb< ' Snowflake 0.2 ' Copyright (c) 2013 Nonki Takahashi. All rights reserved. ' ' History: ' 0.2 2013-12-10 Adjusted timing. (QMD035-0) ' 0.1 2013-12-10 Created. (QMD035) ' gw = 624 gh = 443 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Snowflake 0.2" GraphicsWindow.BackgroundColor = "Black" x0 = gw / 2 y0 = gh / 2 r = 3 color = "#99FFFFFF" While "True" x = x0 y = y0 GraphicsWindow.Clear() DrawParticle() For j = 1 To 360 GetNextXY() For i = 1 To 6 _a = Math.GetRadians(i * 60) x = x0 + (_x - x0) * Math.Sin(_a) + (_y - y0) * Math.Cos(_a) y = y0 + (_x - x0) * Math.Cos(_a) - (_y - y0) * Math.Sin(_a) DrawParticle() xs = x x = y - y0 + x0 y = xs - x0 + y0 DrawParticle() EndFor x = _x y = _y Program.Delay(50) EndFor Program.Delay(4000) EndWhile Sub GetNextXY ' param x, y - current x, y ' return _x, _y - next x, y dir = Math.GetRandomNumber(6) - 1 _dir = Math.GetRadians(dir * 60) _x = x + r * Math.SquareRoot(3) * Math.Cos(_dir) _y = y + r * Math.SquareRoot(3) * Math.Sin(_dir) EndSub Sub DrawParticle ' Draw Particle ' param x, y - center of hexagon ' param r - circumradius of hexagon ' param color - color of hexagon GraphicsWindow.BrushColor = color GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r) EndSub End>QMD035-0.sb< Start>QMD035-2.sb< ' Snowflake 0.4 ' Copyright (c) 2013 Nonki Takahashi. All rights reserved. ' ' History: ' 0.4 2013-12-11 Many snowflakes version. (QMD035-2) ' 0.3 2013-12-10 Changed reflection. (QMD035-1) ' 0.2 2013-12-10 Adjusted timing. (QMD035-0) ' 0.1 2013-12-10 Created. (QMD035) ' gw = 624 gh = 443 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Snowflake 0.4" GraphicsWindow.BackgroundColor = "Black" r = 3 color = "#99FFFFFF" While "True" x0 = Math.GetRandomNumber(gw - 100) + 50 y0 = Math.GetRandomNumber(gh - 100) + 50 x = x0 y = y0 GraphicsWindow.BrushColor = "#11000000" GraphicsWindow.FillRectangle(0, 0, gw, gh) DrawParticle() For j = 1 To 60 GetNextXY() For i = 1 To 6 _a = Math.GetRadians(i * 60) x = x0 + (_x - x0) * Math.Sin(_a) + (_y - y0) * Math.Cos(_a) y = y0 + (_x - x0) * Math.Cos(_a) - (_y - y0) * Math.Sin(_a) DrawParticle() y = 2 * y0 - y DrawParticle() EndFor x = _x y = _y Program.Delay(50) EndFor EndWhile Sub GetNextXY ' param x, y - current x, y ' return _x, _y - next x, y dir = Math.GetRandomNumber(6) - 1 _dir = Math.GetRadians(dir * 60) _x = x + r * Math.SquareRoot(3) * Math.Cos(_dir) _y = y + r * Math.SquareRoot(3) * Math.Sin(_dir) EndSub Sub DrawParticle ' Draw Particle ' param x, y - center of hexagon ' param r - circumradius of hexagon ' param color - color of hexagon GraphicsWindow.BrushColor = color GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r) EndSub End>QMD035-2.sb< Start>QMD035-3.sb< ' Snowflake ' Version 0.5 ' Copyright © 2013-2016 Nonki Takahashi. The MIT License. ' ' History: ' 0.5 2016-12-20 Small version. (QMD035-3) ' 0.4 2013-12-11 Many snowflakes version. (QMD035-2) ' 0.3 2013-12-10 Changed reflection. (QMD035-1) ' 0.2 2013-12-10 Adjusted timing. (QMD035-0) ' 0.1 2013-12-10 Created. (QMD035) ' gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Snowflake 0.5" GraphicsWindow.BackgroundColor = "Black" r = 1 color = "#99FFFFFF" While "True" x0 = Math.GetRandomNumber(gw - 100) + 50 y0 = Math.GetRandomNumber(gh - 100) + 50 x = x0 y = y0 GraphicsWindow.BrushColor = "#11000000" GraphicsWindow.FillRectangle(0, 0, gw, gh) DrawParticle() For j = 1 To 40 GetNextXY() For i = 1 To 6 _a = Math.GetRadians(i * 60) x = x0 + (_x - x0) * Math.Sin(_a) + (_y - y0) * Math.Cos(_a) y = y0 + (_x - x0) * Math.Cos(_a) - (_y - y0) * Math.Sin(_a) DrawParticle() y = 2 * y0 - y DrawParticle() EndFor x = _x y = _y Program.Delay(50) EndFor EndWhile Sub GetNextXY ' param x, y - current x, y ' return _x, _y - next x, y dir = Math.GetRandomNumber(6) - 1 _dir = Math.GetRadians(dir * 60) _x = x + r * Math.SquareRoot(3) * Math.Cos(_dir) _y = y + r * Math.SquareRoot(3) * Math.Sin(_dir) EndSub Sub DrawParticle ' Draw Particle ' param x, y - center of hexagon ' param r - circumradius of hexagon ' param color - color of hexagon GraphicsWindow.BrushColor = color GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r) EndSub End>QMD035-3.sb< Start>QMD035.sb< ' Snow Flake 0.1 ' Copyright (c) 2013 Nonki Takahashi. All rights reserved. ' gw = 624 gh = 443 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Snow Flake 0.1" GraphicsWindow.BackgroundColor = "Black" x0 = gw / 2 y0 = gh / 2 r = 2 color = "#CCFFFFFF" While "True" x = x0 y = y0 GraphicsWindow.Clear() DrawParticle() For j = 1 To 400 GetNextXY() For i = 1 To 6 _a = Math.GetRadians(i * 60) x = x0 + (_x - x0) * Math.Sin(_a) + (_y - y0) * Math.Cos(_a) y = y0 + (_x - x0) * Math.Cos(_a) - (_y - y0) * Math.Sin(_a) DrawParticle() xs = x x = y - y0 + x0 y = xs - x0 + y0 DrawParticle() EndFor x = _x y = _y EndFor Program.Delay(3000) EndWhile Sub GetNextXY ' param x, y - current x, y ' return _x, _y - next x, y dir = Math.GetRandomNumber(6) - 1 _dir = Math.GetRadians(dir * 60) _x = x + r * Math.SquareRoot(3) * Math.Cos(_dir) _y = y + r * Math.SquareRoot(3) * Math.Sin(_dir) EndSub Sub DrawParticle ' Draw Particle ' param x, y - center of hexagon ' param r - circumradius of hexagon ' param color - color of hexagon GraphicsWindow.BrushColor = color GraphicsWindow.FillEllipse(x - r, y - r, 2 * r, 2 * r) EndSub End>QMD035.sb< Start>QMD177.sb< Initialise() While 0=0 UpdateMultilineTextBox() If buttonClicked Then lastBtn = Controls.LastClickedButton Controls.SetTextBoxText(txtBox Controls.GetButtonCaption(lastBtn)) buttonClicked = "False" EndIf Program.Delay(50) EndWhile Sub UpdateMultilineTextBox mseX = GraphicsWindow.MouseX mseY = GraphicsWindow.MouseY For i = 1 To Array.GetItemCount(ctrlCurse) If mseX > Shapes.GetLeft(ctrlCurse[i]) And mseX < Shapes.GetLeft(ctrlCurse[i]) + ctrl["width"] Then If mseY > Shapes.GetTop(ctrlCurse[i]) And mseY < Shapes.GetTop(ctrlCurse[i]) + ctrl["height"] Then Shapes.SetOpacity(ctrlCurse[i] 25) Else Shapes.SetOpacity(ctrlCurse[i] 0) EndIf Else Shapes.SetOpacity(ctrlCurse[i] 0) EndIf EndFor EndSub Sub Initialise GraphicsWindow.Show() txt[1] = "1: Hello" txt[2] = "2: World" txt[3] = "3: ML TextBox" ctrl = "width=100;height=15" pad = 5 mlTxtBox = Controls.AddMultiLineTextBox(10-pad 10-pad) Controls.SetSize(mlTxtBox, ctrl["width"] + pad*2 , Array.GetItemCount(txt) * ctrl["height"] + pad*2) For i = 1 To Array.GetItemCount(txt) txtShp[i] = Shapes.AddText(txt[i]) Controls.SetSize(txtShp[i] ctrl["width"] ctrl["height"]) Shapes.Move(txtShp[i], 10, 10 + (i-1) * ctrl["height"]) ctrlCurse[i] = Controls.AddButton(txt[i] 0 0) Controls.SetSize(ctrlCurse[i] ctrl["width"]+pad ctrl["height"]) Shapes.Move(ctrlCurse[i], 10, 10 + (i-1) * ctrl["height"]) Shapes.SetOpacity(ctrlCurse[i] 0) EndFor txtBox = Controls.AddTextBox(10-pad, pad*2 + Array.GetItemCount(txt)*ctrl["height"] + 10 ) Controls.ButtonClicked = OnButtonClicked EndSub Sub OnButtonClicked buttonClicked = "True" EndSub End>QMD177.sb< Start>QMF228.sb< cc[1]="..####.. ##### . #### . #### .######. ###### .$#####. #### .#$ @# #### #$ @# $# #### @#### ###### #######. #$ # @# # # #$ #@ .#####...#####...#$ @# .#$ @#.@# $#.#$ #@ cc[2]=".#$ @#. #$ @# .#$ @#. #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ @# #$ @# $# #$ @# $# #$ $# . #$ ## @# ## ## #$ #@ .#$ @#..#$ @#..#$ @# .#$ @# @# $# #$ #@ cc[3]=".#$ @#. ##### .#$ . #$ @# .##### . ##### . $# . #$ $# .#$ @# #$ ###### $# #### @# $# #$ $# . #$ #$# @# #$##@# ###@ .#$ @#..#$ @#..#$ @# .#$ @# @## #$#@ cc[4]=".######. #$ @# .#$ . #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ ### #$ @# #@ $# $# @# # $# #$ $# . #$ #@$#@# #$ @# #$$# .##### ..##### ..#$ @# .#$ @# $## #$ cc[5]=".#$ @#. #$ @# .#$ @#. #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ @# #$ @# #@ $# #$ $# @# #$# #$ $# . #$ #@ $## #$ @# #$ $# .#$ ..#$ @# .. #$@# .#$##@# $# @# #$ cc[6]=".#$ @#. ##### . #### . #### .######. #$ .$#####. #### . #### #### #$ @# #### #### @#### ###### $# . ###### #@ $# #$ @# #$ $# .#$ ..#$ @#.. ## . # # $# @# #$ cc[7]=".................................................................... ........ ................................................................................................................................ GraphicsWindow.PenWidth=0 GraphicsWindow.BackgroundColor="tan GraphicsWindow.BrushColor="darkblue GraphicsWindow.Width=1500 GraphicsWindow.Title="ZX Screen Hommage ix="ABCDEFIOUGHJSQZTLNMKPRVWXY " For yy=50 To 640 Step 32 TXTm=LDText.Split("THE QUICK BROWN FOX JUMPS OVER LAZY DOGS" " ") txt="" bl=text.GetSubTextToEnd("@$#" Math.Remainder(ps 3)+1) ps=ps+1 For w=1 To 70 m=Math.GetRandomNumber(8) If txtm[m]="" Then Else txt=txt+txtm[m]+" " txtm[m]="" EndIf EndFor tu= Text.ConvertToUpperCase(txt) For f=1 To 40 y=0 GraphicsWindow.BrushColor=LDColours.HSLtoRGB(240 .8 math.GetRandomNumber(5)/10) r=Shapes.AddRectangle(32 32) Shapes.Move(r (f*8)*4+20 yy ) GraphicsWindow.BrushColor="orange ldShapes.AnimateOpacity(r 750 5) LDShapes.SetShapeEvent(r) Program.Delay(5) For x=0 To 7 For y=0 To 7 n=x+8*(Text.GetIndexOf(ix text.GetSubText(tu f 1))-1)+1 If Text.IsSubText (bl text.getSubText(cc[y] n 1)) Then e=shapes.AddRectangle(4 4) shapes.move(e (x+f*8)*4+20 y*4+yy ) EndIf EndFor EndFor EndFor EndFor zz=1 LDEvents.MouseWheel=mwww LDShapes.ShapeEvent=see Sub see ls=LDShapes.LastEventShape If LDShapes.LastEventType="MouseEnter" Then ldShapes.AnimateOpacity(ls 750 5) EndIf EndSub Sub mwww zz=zz+LDEvents.LastMouseWheelDelta/15 LDGraphicsWindow.Reposition(zz zz 0 zz*100 0) EndSub End>QMF228.sb< Start>QMF510.sb< 'Set graphics window gw=800'Desktop.Width gh=600'Desktop.Height GraphicsWindow.Width=gw GraphicsWindow.Height=gh GraphicsWindow.CanResize="false" GraphicsWindow.BackgroundColor="Black" GraphicsWindow.MouseMove = OnMouseMove 'Set suns nsun=50 size=10 Ang=0.1 gsize=Math.Min(gw,gh) For i=1 To nsun GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor() sun=shapes.AddEllipse(size,size) Array.SetValue("suns",i,sun) Array.SetValue("X",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("Y",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("Z",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("U",i,Ang*(Array.GetValue("Y",i)-gsize/2)) Array.SetValue("V",i,-Ang*(Array.GetValue("X",i)-gsize/2)) Array.SetValue("W",i,0) EndFor 'Move suns dt=1 grav=10 fric=0.0 While("true") For i=1 To nsun Xacc=0 Yacc=0 Zacc=0 For j=1 To nsun If (i <> j) Then Xdist=Array.GetValue("X",j)-Array.GetValue("X",i) Ydist=Array.GetValue("Y",j)-Array.GetValue("Y",i) Zdist=Array.GetValue("Z",j)-Array.GetValue("Z",i) dist2=Xdist*Xdist+Ydist*Ydist+Zdist*Zdist dist2=Math.Max(dist2,100) Xacc=Xacc+grav*Xdist/dist2 Yacc=Yacc+grav*Ydist/dist2 Zacc=Zacc+grav*Zdist/dist2 EndIf EndFor array.SetValue("AccX",i,Xacc) array.SetValue("AccY",i,Yacc) array.SetValue("AccZ",i,Zacc) EndFor For i=1 To nsun array.SetValue("U",i,(1-fric)*array.GetValue("U",i)+dt*array.GetValue("AccX",i)) array.SetValue("V",i,(1-fric)*array.GetValue("V",i)+dt*array.GetValue("AccY",i)) array.SetValue("W",i,(1-fric)*array.GetValue("W",i)+dt*array.GetValue("AccZ",i)) array.SetValue("X",i,array.GetValue("X",i)+dt*array.GetValue("U",i)) array.SetValue("Y",i,array.GetValue("Y",i)+dt*array.GetValue("V",i)) array.SetValue("Z",i,array.GetValue("Z",i)+dt*array.GetValue("W",i)) EndFor While (Mouse.IsLeftButtonDown) For i=1 To nsun x=array.GetValue("X",i)*Math.Cos(Xeye)+array.GetValue("Z",i)*Math.Sin(Xeye) z=-array.GetValue("X",i)*Math.Sin(Xeye)+array.GetValue("Z",i)*Math.Cos(Xeye) array.SetValue("X",i,x) array.SetValue("Z",i,z) y=array.GetValue("Y",i)*Math.Cos(Yeye)+array.GetValue("Z",i)*Math.Sin(Yeye) z=-array.GetValue("Y",i)*Math.Sin(Yeye)+array.GetValue("Z",i)*Math.Cos(Yeye) array.SetValue("Y",i,y) array.SetValue("Z",i,z) EndFor x=0 y=0 For i=1 To nsun x=x+array.GetValue("X",i) y=y+array.GetValue("Y",i) EndFor x=x/nsun y=y/nsun For i=1 To nsun array.SetValue("X",i,array.GetValue("X",i)-(x-gw/2)) array.SetValue("Y",i,array.GetValue("Y",i)-(y-gh/2)) sun=array.GetValue("suns",i) Shapes.Move(sun,array.GetValue("X",i),array.GetValue("Y",i)) EndFor EndWhile x=0 y=0 For i=1 To nsun x=x+array.GetValue("X",i) y=y+array.GetValue("Y",i) EndFor x=x/nsun y=y/nsun For i=1 To nsun array.SetValue("X",i,array.GetValue("X",i)-(x-gw/2)) array.SetValue("Y",i,array.GetValue("Y",i)-(y-gh/2)) sun=array.GetValue("suns",i) Shapes.Move(sun,array.GetValue("X",i),array.GetValue("Y",i)) EndFor EndWhile Sub OnMouseMove Xeye=-(GraphicsWindow.MouseX-gw/2)/10000 Yeye=-(GraphicsWindow.MouseY-gh/2)/10000 EndSub End>QMF510.sb< Start>QMF747-0.sb< ' mahreen miangul ' Multiple KeyBoard ' JanUary 2018 'GraphicsWindow.Left = 0.5 * (Desktop.Width - GraphicsWindow.Width) 'GraphicsWindow.Top = 0.5 * (Desktop.Height - GraphicsWindow.Height) GraphicsWindow.top= -2.0 GraphicsWindow.left= 80 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.backgroundcolor = "black" GraphicsWindow.Width = 1280 GraphicsWindow.Height = 666 GraphicsWindow.KeyDown = onkeyDown '=============================Makesprite()============================ SPRITE_init() add_shapes() ' ============================== Aircraft Animation====================== dZ = 0.1 zoom = 1 For i=1 to 4 '<----**** ddx[i]=-(2+Math.GetRandomNumber(50)/10) '<----**** endfor '<----**** ddy=0 bdx=0 bdy=5 bdy2=5 ' - initial ball2 moving speed-Y BNMB="6:1" ' Blue car shapes number=6 repeat =1 shoot="False" shoot2="False" zm=1 Hit_count=0 No_hit=0 shootNMB=0 '<----**** ' ============================== Cannon Animation ============================== GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor= "Red" For i=1 to 4 '<----**** ANMB="5:"+i '<----**** Ball[i]=Shapes.AddEllipse(10,20) '<----**** Shapes.Move(Ball[i],shapes.GetLeft(shp[ANMB][9])+10,shapes.Gettop(shp[ANMB][9])+30) '<----**** Shapes.HideShape(Ball[i]) '<----**** sht[i]="False" '<----**** endfor '<----**** GraphicsWindow.BrushColor= "snow" For i=1 to 10 '<----**** Ball2[i]=Shapes.AddEllipse(10,20) '<----**** Shapes.Move(Ball2[i],shapes.GetLeft(shp[BNMB][14]),shapes.Gettop(shp[BNMB][14])) '<----**** Shapes.HideShape(Ball2[i]) '<----**** sht2[i]="False" '<----**** endfor '<----**** ' ============================== BlueCar Timer ==================================== Timer.Interval=800 Timer.Tick=Cannon_up ' ==============================Aircraft Animation and Blinkig 1====================== While "True" ' Program.Delay(20) '============================Aircraft Blinking Program======================= zoom = zoom - dZ For ii=1 To Array.GetItemCount(s[5])'<----**** ANMB="5:"+ii '<----**** For i = 1 To Array.GetItemCount(shape[5]) If Array.ContainsValue(shape[5][i], "eye") or Array.ContainsValue(shape[5][i], "mouth") Then Shapes.Zoom(shp[ANMB][i], 1, zoom) EndIf shapes.Move(shp[ANMB][i],shapes.GetLeft(shp[ANMB][i])+ddx[ii],shapes.Gettop(shp[ANMB][i])+ddy)'<----**** EndFor '============================Aircraft Reverse Moving=====X,Y Direction============= cycleX[ii]= shapes.GetLeft(shp[ANMB][5]) '<----**** cycley[ii]= shapes.Gettop(shp[ANMB][5]) '<----**** If cycleX[ii]<-100 Or cycleX[ii]>GraphicsWindow.Width+100 Then'<----**** ddx[ii]=-ddx[ii] '<----**** EndIf endfor '<----**** If zoom = 0.1 Or zoom = 1 Then dZ = -dZ EndIf ' ===========================BallFire======================================= bn= Math.GetRandomNumber(50) '<----**** If math.Remainder(bn,11)=0 and sht[bn/11]="False" Then '<----**** 11,22,33,44, sht[bn/11]="True" '<----**** shapes.Move(Ball[bn/11] ,shapes.GetLeft(shp["5:"+bn/11][9])+10,shapes.Gettop(shp["5:"+bn/11][9])+30)'<----**** EndIf '<----**** For i=1 To 4 '<----**** If sht[i]="True" Then '<----**** Shapes.ShowShape(Ball[i]) '<----**** shapes.Move(Ball[i] ,shapes.GetLeft(ball[i])+bdx/2,shapes.Gettop(ball[i])+bdy/2) '<----**** If shapes.Gettop(ball[i])>700 Then '<----**** sht[i]="False" '<----**** No_hit=No_hit+1 GraphicsWindow.Title="You Hit !!!!!! Total "+(Hit_count*10-No_hit*5) +" Points get" Shapes.Move(Ball[i],shapes.GetLeft(shp["5:"+bn/11][9])+10,shapes.Gettop(shp["5:"+bn/11][9])+30)'<----**** Shapes.HideShape(Ball[i]) '<----**** EndIf '==========================Collision Check Here================================= Cannon_X=shapes.GetLeft(shp[BNMB][5]) Cannon_Y=shapes.GetTop(shp[BNMB][5]) ballX=shapes.GetLeft(ball[i]) bally=shapes.GetTop(ball[i]) If (Cannon_X700 Then shoot="False" No_hit=No_hit+1 GraphicsWindow.Title="You Hit !!!!!! Total "+(Hit_count*10-No_hit*5) +" Points get" Shapes.Move(Ball,shapes.GetLeft(shp[ANMB][9])+10,shapes.Gettop(shp[ANMB][9])+30) Shapes.HideShape(Ball) EndIf '==========================Collision Check Here================================= Cannon_X=shapes.GetLeft(shp[BNMB][5]) Cannon_Y=shapes.GetTop(shp[BNMB][5]) ballX=shapes.GetLeft(ball) bally=shapes.GetTop(ball) If (Cannon_X>>> shape[5][13] = "func=ell;x=-177;y=270;width=25;height=25;angle=0;bc=Gainsboro;pc=darkslategray;pw=4;tag=eye" ' eye 2 ' <<<<>>>> shape[5][14] = "func=ell;x=-250;y=177;width=44;height=22;angle=0;bc=deeppink;pc=yellow;pw=2;tag=mouth" ' ' <<<<>>>> shape[5][15] = "func=ell;x=-255;y=166;width=22;height=44;angle=0;bc=yellow;pc=deeppink;pw=2;tag=mouth" ' ' <<<<>>>> ' Cannon s[6] ="1=0.5" shX[6] ="1=50" shY[6] ="1=545" shape[6][1] = "func=rect;x=90;y=45;width=20;height=44;bc=red;pw=0;" shape[6][2] = "func=rect;x=105;y=45;width=20;height=44;bc=green;pw=0;" shape[6][3] = "func=rect;x=127;y=45;width=20;height=44;bc=yellow;pw=0;" shape[6][4] = "func=rect;x=147;y=43;width=20;height=55;bc=blue;pw=0;" shape[6][5] = "func=rect;x=33;y=30;width=55;height=68;bc=darkslategray=0;" shape[6][6] = "func=rect;x=44;y=44;width=33;height=33;bc=snow;pw=0;" shape[6][7] = "func=ell;x=46;y=46;width=30;height=30;bc=darkslategray;pw=0;" shape[6][8] = "func=rect;x=0;y=150;width=330;height=90;bc=darkslategray;pw=0;" shape[6][9] = "func=ell;x=0;y=80;width=210;height=140;bc=darkslategray;pw=0;" shape[6][10]="func=ell;x=40;y=120;width=33;height=22;angle=-50;bc=snow;pw=0.5" shape[6][11]="func=ell;X=130;Y=120;width=33;height=22;angle=50;bc=mediumslateblue;pw=0.5" shape[6][12]="func=rect;X=40;Y=180;width=33;height=22;angle=40;bc=mediumslateblue;pc=darkslategray;pw=0" shape[6][13]="func=rect;X=130;Y=180;width=33;height=22;angle=-40;bc=snow;pc=darkslategray;pw=0" shape[6][14]="func=rect;X=210;Y=50;width=40;height=100;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 shape[6][15]="func=rect;x=204;y=20;width=50;height=30;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 ' Tree s[7]="1=0.8;2=.8;3=.8;4=.8;" shX[7]="1=10;2=150;3=920;4=1100" shY[7]="1=300;2=300;3=330;4=330" ' 5,6,13,14 shape[7]=shape[1] 'Apple s[8] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=.2;8=.2;" shX[8] ="1=140;2=650;3=-80;4=0;5=100;6=740;7=920;8=1100" shY[8] ="1=444;2=420;3=440;4=420;5=420;6=420;7=480;8=460" endsub End>QMF747-0.sb< Start>QMF747-1.sb< ' mahreen miangul ' Multiple KeyBoard ' JanUary 2018 'GraphicsWindow.Left = 0.5 * (Desktop.Width - GraphicsWindow.Width) 'GraphicsWindow.Top = 0.5 * (Desktop.Height - GraphicsWindow.Height) GraphicsWindow.top= -2.0 GraphicsWindow.left= 80 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.backgroundcolor = "black" GraphicsWindow.Width = 1280 GraphicsWindow.Height = 666 GraphicsWindow.KeyDown = onkeyDown '=============================Makesprite()============================ SPRITE_init() add_shapes() ' ============================== Aircraft Animation====================== dZ = 0.1 zoom = 1 For i=1 to 4 '<----**** ddx[i]=-(2+Math.GetRandomNumber(50)/10) '<----**** endfor '<----**** ddy=0 bdx=0 bdy=30 bdy2=20 ' - initial ball2 moving speed-Y BNMB="6:1" ' Blue car shapes number=6 repeat =1 shoot="False" shoot2="False" zm=1 shootNMB=10 '<----**** ' ============================== Cannon Animation ============================== GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor= "Red" For i=1 to 4 '<----**** ANMB="5:"+i '<----**** Ball[i]=Shapes.AddEllipse(10,20) '<----**** Shapes.Move(Ball[i],shapes.GetLeft(shp[ANMB][9])+10,shapes.Gettop(shp[ANMB][9])+30) '<----**** Shapes.HideShape(Ball[i]) '<----**** sht[i]="False" '<----**** endfor '<----**** GraphicsWindow.BrushColor= "snow" For i=1 to 10 '<----**** Ball2[i]=Shapes.AddEllipse(10,20) '<----**** Shapes.Move(Ball2[i],shapes.GetLeft(shp[BNMB][14]),shapes.Gettop(shp[BNMB][14])) '<----**** Shapes.HideShape(Ball2[i]) '<----**** sht2[i]="False" '<----**** endfor '<----**** ' ==============================Aircraft Animation and Blinkig 1====================== While "True" ' NN=NN+1 '<----**** If Math.Remainder(NN,7)=0 Then '<----**** For k=1 To Array.GetItemCount(s[6]) For L=1 To Array.GetItemCount(shape[6])-2 ' Shapes.Rotate(SHP["6:"+k][L],Shape[6][L]["angle"]) EndFor EndFor EndIf AircraftBlinking() '<----**** aircraftFire() '<----**** BluecarFire() '<----**** If Math.Remainder(NN,11)=0 Then '<----**** For k=1 To Array.GetItemCount(s[6]) For L=1 To Array.GetItemCount(shape[6])-2 ' Shapes.Rotate(SHP["6:"+K][L], 0) EndFor EndFor EndIf Program.Delay(25) endwhile Sub AircraftBlinking '============================Aircraft Blinking Program======================= zoom = zoom - dZ For ii=1 To 4 '<----**** ANMB="5:"+ii '<----**** For i = 1 To Array.GetItemCount(shape[5]) If Array.ContainsValue(shape[5][i], "eye") or Array.ContainsValue(shape[5][i], "mouth") Then Shapes.Zoom(shp[ANMB][i], 1, zoom) EndIf shapes.Move(shp[ANMB][i],shapes.GetLeft(shp[ANMB][i])+ddx[ii],shapes.Gettop(shp[ANMB][i])+ddy)'<----**** EndFor '============================Aircraft Reverse Moving=====X,Y Direction============= cycleX[ii]= shapes.GetLeft(shp[ANMB][5]) '<----**** cycley[ii]= shapes.Gettop(shp[ANMB][5]) '<----**** If cycleX[ii]<-100 Or cycleX[ii]>GraphicsWindow.Width+100 Then'<----**** ddx[ii]=-ddx[ii] '<----**** EndIf endfor '<----**** If zoom = 0.1 Or zoom = 1 Then dZ = -dZ EndIf EndSub Sub aircraftFire ' ===========================BallFire======================================= bn= Math.GetRandomNumber(10) '<----**** If math.Remainder(bn,2)=0 and sht[bn/2]="False" Then '<----**** sht[bn/2]="True" '<----**** shapes.Move(Ball[bn/2] ,shapes.GetLeft(shp["5:"+bn/2][9])+10,shapes.Gettop(shp["5:"+bn/2][9])+30)'<----**** EndIf '<----**** For i=1 To 4 '<----**** If sht[i]="True" Then '<----**** Shapes.ShowShape(Ball[i]) '<----**** shapes.Move(Ball[i] ,shapes.GetLeft(ball[i])+bdx/2,shapes.Gettop(ball[i])+bdy/2) '<----**** If shapes.Gettop(ball[i])>700 Then '<----**** sht[i]="False" '<----**** GraphicsWindow.Title="You Hit !!!!!! Total " Shapes.Move(Ball[i],shapes.GetLeft(shp["5:"+bn/2][9])+10,shapes.Gettop(shp["5:"+bn/2][9])+30)'<----**** Shapes.HideShape(Ball[i]) '<----**** EndIf '==========================Collision Check Here================================= Cannon_X=shapes.GetLeft(shp[BNMB][5]) Cannon_Y=shapes.GetTop(shp[BNMB][5]) ballX=shapes.GetLeft(ball[i]) '<----**** bally=shapes.GetTop(ball[i]) '<----**** If (Cannon_X>>> shape[5][13] = "func=ell;x=-177;y=270;width=25;height=25;angle=0;bc=Gainsboro;pc=darkslategray;pw=4;tag=eye" ' eye 2 ' <<<<>>>> shape[5][14] = "func=ell;x=-250;y=177;width=44;height=22;angle=0;bc=deeppink;pc=yellow;pw=2;tag=mouth" ' ' <<<<>>>> shape[5][15] = "func=ell;x=-255;y=166;width=22;height=44;angle=0;bc=yellow;pc=deeppink;pw=2;tag=mouth" ' ' <<<<>>>> ' Cannon s[6] ="1=0.5" shX[6] ="1=50" shY[6] ="1=545" shape[6][1] = "func=rect;x=90;y=45;width=20;height=44;bc=red;pw=0;" shape[6][2] = "func=rect;x=105;y=45;width=20;height=44;bc=green;pw=0;" shape[6][3] = "func=rect;x=127;y=45;width=20;height=44;bc=yellow;pw=0;" shape[6][4] = "func=rect;x=147;y=43;width=20;height=55;bc=blue;pw=0;" shape[6][5] = "func=rect;x=33;y=30;width=55;height=68;bc=darkslategray=0;" shape[6][6] = "func=rect;x=44;y=44;width=33;height=33;bc=snow;pw=0;" shape[6][7] = "func=ell;x=46;y=46;width=30;height=30;bc=darkslategray;pw=0;" shape[6][8] = "func=rect;x=0;y=150;width=330;height=90;bc=darkslategray;pw=0;" shape[6][9] = "func=ell;x=0;y=80;width=210;height=140;bc=darkslategray;pw=0;" shape[6][10]="func=ell;x=40;y=120;width=33;height=22;angle=-50;bc=snow;pw=0.5" shape[6][11]="func=ell;X=130;Y=120;width=33;height=22;angle=50;bc=mediumslateblue;pw=0.5" shape[6][12]="func=rect;X=40;Y=180;width=33;height=22;angle=40;bc=mediumslateblue;pc=darkslategray;pw=0" shape[6][13]="func=rect;X=130;Y=180;width=33;height=22;angle=-40;bc=snow;pc=darkslategray;pw=0" shape[6][14]="func=rect;X=210;Y=50;width=40;height=100;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 shape[6][15]="func=rect;x=204;y=20;width=50;height=30;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 ' Tree s[7]="1=0.8;2=.8;3=.8;4=.8;" shX[7]="1=10;2=150;3=920;4=1100" shY[7]="1=300;2=300;3=330;4=330" ' 5,6,13,14 shape[7]=shape[1] 'Apple s[8] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=.2;8=.2;" shX[8] ="1=140;2=650;3=-80;4=0;5=100;6=740;7=920;8=1100" shY[8] ="1=444;2=420;3=440;4=420;5=420;6=420;7=480;8=460" endsub End>QMF747-1.sb< Start>QMF747.sb< ' mahreen miangul ' Multiple KeyBoard ' JanUary 2018 'GraphicsWindow.Left = 0.5 * (Desktop.Width - GraphicsWindow.Width) 'GraphicsWindow.Top = 0.5 * (Desktop.Height - GraphicsWindow.Height) GraphicsWindow.top= -2.0 GraphicsWindow.left= 80 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.backgroundcolor = "black" GraphicsWindow.Width = 1280 GraphicsWindow.Height = 666 GraphicsWindow.KeyDown = onkeyDown '=============================Makesprite()============================ SPRITE_init() add_shapes() ' ============================== Aircraft Animation====================== dZ = 0.1 zoom = 1 ddx=0 ddy=0 bdx=0 bdy=0 bdy2=5 ' <------ initial ball2 moving speed-Y ANMB="5:1" ANMB1="5.1" BNMB="6:1" ' <----- Blue car shapes number=6 repeat =1 shoot="False" shoot2="False" ' <----- zm=1 Hit_count=0 No_hit=0 ' ============================== Cannon Animation ============================== GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor= "Red" Ball=Shapes.AddEllipse(10,20) Shapes.Move(Ball,shapes.GetLeft(shp[ANMB][9])+10,shapes.Gettop(shp[ANMB][9])+30) Shapes.HideShape(Ball) GraphicsWindow.BrushColor= "snow" ' <----- Ball2=Shapes.AddEllipse(10,20) ' <----- Shapes.Move(Ball2,shapes.GetLeft(shp[BNMB][14]),shapes.Gettop(shp[BNMB][14]))' <----- Shapes.Move(Ball2,shapes.GetLeft(shp[BNMB][15]),shapes.Gettop(shp[BNMB][15]))' <----- Shapes.HideShape(Ball2)' <----- ' ============================== BlueCar Timer ==================================== Timer.Interval=800 Timer.Tick=Cannon_up ' ==============================Aircraft Animation and Blinkig 1====================== While "True" ' And "North" <> "South" <--- No meanig , it always "True" Program.Delay(20) '============================Aircraft Blinking Program======================= zoom = zoom - dZ For i = 1 To Array.GetItemCount(shape[5]) If Array.ContainsValue(shape[5][i], "eye") Then Shapes.Zoom(shp[ANMB][i], 1, zoom) Shapes.Zoom(shp[ANMB1][i], 1, zoom) ElseIf Array.ContainsValue(shape[5][i], "mouth") Then Shapes.Zoom(shp[ANMB][i], zoom, zoom) ElseIf Array.ContainsValue(shape[5][i], "mouth") Then Shapes.Zoom(shp[ANMB1][i], zoom, zoom) EndIf shapes.Move(shp[ANMB][i],shapes.GetLeft(shp[ANMB][i])+ddx,shapes.Gettop(shp[ANMB][i])+ddy) EndFor If zoom = 0.1 Or zoom = 1 Then dZ = -dZ EndIf ' ============================haroon rashid 1========================== mmm= Math.GetRandomNumber(80) ' blinking star number If mmm=50 Then Program.Delay(30) zm=zm+0.1 EndIf Program.Delay(20) ' <<<<>>>> '============================Aircraft Reverse Moving=====X,Y Direction============= cycleX= shapes.GetLeft(shp[ANMB][5]) cycleY= shapes.GetTop(shp[ANMB][5]) If cycleX<0 Or cycleX>GraphicsWindow.Width Then ddx=-ddx EndIf If cycleY<0 Or cycleY>200 Then ddy=-ddy EndIf cycleX= shapes.GetLeft(shp[ANMB1][5]) cycleY= shapes.GetTop(shp[ANMB1][5]) If cycleX<0 Or cycleX>GraphicsWindow.Width Then ddx=-ddx EndIf If cycleY<0 Or cycleY>200 Then ddy=-ddy EndIf ' ===========================BallFire======================================= If shoot Then shapes.Move(Ball ,shapes.GetLeft(ball)-bdx/2,shapes.Gettop(ball)-bdy/2) If shapes.Gettop(ball)>700 Then shoot="False" No_hit=No_hit+1 GraphicsWindow.Title="You Hit !!!!!! Total "+(Hit_count*10-No_hit*5) +" Points get" Shapes.Move(Ball,shapes.GetLeft(shp[ANMB][9])+10,shapes.Gettop(shp[ANMB][9])+30) Shapes.HideShape(Ball) EndIf '==========================Collision Check Here================================= Cannon_X=shapes.GetLeft(shp[BNMB][5]) Cannon_Y=shapes.GetTop(shp[BNMB][5]) ballX=shapes.GetLeft(ball) bally=shapes.GetTop(ball) If (Cannon_X>>> shape[5][13] = "func=ell;x=-177;y=270;width=25;height=25;angle=0;bc=Gainsboro;pc=darkslategray;pw=4;tag=eye" ' eye 2 ' <<<<>>>> shape[5][14] = "func=ell;x=-250;y=177;width=44;height=22;angle=0;bc=deeppink;pc=yellow;pw=2;tag=mouth" ' ' <<<<>>>> shape[5][15] = "func=ell;x=-255;y=166;width=22;height=44;angle=0;bc=yellow;pc=deeppink;pw=2;tag=mouth" ' ' <<<<>>>> ' Cannon s[6] ="1=0.5" shX[6] ="1=50" shY[6] ="1=545" shape[6][1] = "func=rect;x=90;y=45;width=20;height=44;bc=red;pw=0;" shape[6][2] = "func=rect;x=105;y=45;width=20;height=44;bc=green;pw=0;" shape[6][3] = "func=rect;x=127;y=45;width=20;height=44;bc=yellow;pw=0;" shape[6][4] = "func=rect;x=147;y=43;width=20;height=55;bc=blue;pw=0;" shape[6][5] = "func=rect;x=33;y=30;width=55;height=68;bc=darkslategray=0;" shape[6][6] = "func=rect;x=44;y=44;width=33;height=33;bc=snow;pw=0;" shape[6][7] = "func=ell;x=46;y=46;width=30;height=30;bc=darkslategray;pw=0;" shape[6][8] = "func=rect;x=0;y=150;width=330;height=90;bc=darkslategray;pw=0;" shape[6][9] = "func=ell;x=0;y=80;width=210;height=140;bc=darkslategray;pw=0;" shape[6][10]="func=ell;x=40;y=120;width=33;height=22;angle=-50;bc=snow;pw=0.5" shape[6][11]="func=ell;X=130;Y=120;width=33;height=22;angle=50;bc=mediumslateblue;pw=0.5" shape[6][12]="func=rect;X=40;Y=180;width=33;height=22;angle=40;bc=mediumslateblue;pc=darkslategray;pw=0" shape[6][13]="func=rect;X=130;Y=180;width=33;height=22;angle=-40;bc=snow;pc=darkslategray;pw=0" shape[6][14]="func=rect;X=210;Y=50;width=40;height=100;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 shape[6][15]="func=rect;x=204;y=20;width=50;height=30;angle=0;bc=darkslategray;pc=black;pw=2" '<------ cannon for ball2 ' Tree s[7]="1=0.8;2=.8;3=.8;4=.8;" shX[7]="1=10;2=150;3=920;4=1100" shY[7]="1=300;2=300;3=330;4=330" ' 5,6,13,14 shape[7]=shape[1] 'Apple s[8] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=.2;8=.2;" shX[8] ="1=140;2=650;3=-80;4=0;5=100;6=740;7=920;8=1100" shY[8] ="1=444;2=420;3=440;4=420;5=420;6=420;7=480;8=460" endsub End>QMF747.sb< Start>QMG224.sb< Sub unset mnx=99999 mny=99999 mxx=-99999 mxy=-99999 ff=LDDialogs.OpenFile ("1=plt" "e:\") xs=1 le="" fm=0 cfl=ff GraphicsWindow.Title =cfl ' The following line could be harmful and has been automatically commented. ' fc=File.ReadContents(cfl) nl="; ll="" ll= LDText.Split(fc,nl) xx=1 ss=1 ca=0 EndSub sfc=200 pau="false not="false=true;true=false TextWindow.WriteLine ("CNC sender V0.1"+nln) TextWindow.WriteLine("Press ESC in view to enter CMD mode"+nln) TextWindow.Left=1200 TextWindow.top=500 nln=Text.GetCharacter (13)+Text.GetCharacter (10) LDUtilities.ShowErrors ="false LDUtilities.ShowNoShapeErrors ="false GraphicsWindow.fillEllipse (1 1 1,1) GraphicsWindow.BrushColor="Black GraphicsWindow.BackgroundColor="Teal GraphicsWindow.Width =1400 GraphicsWindow.Height =450 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.Title="PlotView unset() sy=900 annlz () LDDialogs.AddRightClickMenu (LDText.Split ("Open Run/Plot Pause ComOpn Home Stop Status CloseCOM" " ") "") LDDialogs.RightClickMenu=rmn GraphicsWindow.KeyDown=kdw Sub kdw lk= text.ConvertToLowerCase (GraphicsWindow.LastKey) If lk="escape" Then cmd="true endif EndSub scfx=1 scfy=1 rpt=1 zstp=.1 d30=30 ldy=5000 mod=0 mtxt=ldtext.Split("Free Plot Laser Print2D 3DPrint Robot3D" " ") While "true"'------------------------------------------------------------looop If cmd Then TextWindow.Write ("?=hlp / CMD: ") cc=text.ConvertToLowerCase (TextWindow.Read()) If cc="?" then TextWindow.WriteLine(LDText.Replace ("//CMDs: / X = exit cmdmod / S(cale%) xx yy / R(epeat) nn / Z(step) ss / I(nfo) / >[cmd] = sends GRBL cmd to CNC//" "/" nln)) ElseIf text.StartsWith (cc "s") then scc=LDText.Split(cc " ") scfx=scc[2] scfy=scc[3] ElseIf text.StartsWith (cc "r") then scc=LDText.Split(cc " ") rpt=scc[2] ElseIf text.StartsWith (cc "i") then TextWindow.WriteLine (nln+"___________ P a r a m s _____________"+nln) TextWindow.WriteLine ("Scale xy: "+ldmath.FixDecimal (scfx 5) +", "+ldmath.FixDecimal (scfy 5)) TextWindow.WriteLine (" Z step: "+ldmath.FixDecimal (zstp 5)) TextWindow.WriteLine (" Repeats: "+rpt) TextWindow.WriteLine ("Delay ms: "+d30) TextWindow.WriteLine ("LyDel ms: "+ldy) TextWindow.WriteLine (" Mode: "+mtxt[mod+1]) TextWindow.WriteLine ("_____________________________________"+nln) ElseIf cc="o" then pp=LDCommPort.OpenPort("COM3" 115200) TextWindow.WriteLine (pp) ElseIf cc="c" then LDCommPort.ClosePort() TextWindow.WriteLine ("CNC Closed.") ElseIf text.StartsWith (cc ">") then rr=LDCommPort.TXString (Text.GetSubTextToEnd (Text.ConvertToUpperCase (cc) 2)+nln) TextWindow.WriteLine (rr) ElseIf cc="x" then cmd="false endif EndIf If pltm Then pp=LDCommPort.OpenPort("COM3" 115200) TextWindow.WriteLine (pp) ac= Array.GetItemCount (ln) For qx=1 To Ac If pau then qx=qx-1 Program.Delay (30) else xy: TextWindow.WriteLine (ln[qx]) rr=LDCommPort.TXString (ln[qx]+nln) Program.Delay (d30) TextWindow.WriteLine (rr) If Text.StartsWith (rr "NOC") then cf=LDDialogs.Confirm ("No CNC connection! Retry?" "Error") If cf="Cancel" then TextWindow.WriteLine ("_______ABORTED_________") Goto xx ElseIf cf="Yes" then Goto xy EndIf endif TextWindow.Title =LDMath.FixDecimal ( qx*100/ac 2)+" %" endif endfor xx: TextWindow.Title ="Done. pltm="false endif endwhile'-------------------------------------------------------------------------------- Sub annlz chkmm() scx=(mxx-mnx) /1380 scy=(mxy-mny) /880 ss=Math.Max(scx,scy) GraphicsWindow.PenWidth =1 TextWindow.WriteLine (mnx+":"+mny) TextWindow.WriteLine (mxx+":"+mxy) TextWindow.WriteLine (uc+"|"+dc) xll=Array.GetItemCount (ll) 'GraphicsWindow.Title =xll GraphicsWindow.MouseMove =mdd For x=1 To xll sst=Text.GetSubText (ll[x],1,2) 'GraphicsWindow.Title =x+":"+xll If Text.IsSubText ("PU PD", sst) Then tt=Text.GetSubTextToEnd (ll[x],3) 'tt=text.GetSubText (tt,1,text.GetIndexOf(tt,";")-1) cc= LDText.Split (tt,",") ca[xx]["x"]=cc[1] ca[xx]["y"]=cc[2] ca[xx]["t"]=Text.GetSubText (ll[x],2,1) xx=xx+1 EndIf EndFor TextWindow.WriteLine ("Nods:"+xx) ppl="" qq=1 cx=1 for x=1 to xx-1 'GraphicsWindow.DrawLine (5+ca[x]["x"]/ss,sy-5-ca[x]["y"]/ss,5+ca[x-1]["x"]/ss,-5+sy-ca[x-1]["y"]/ss) If x>1 And ca[x]["t"]="U" Then qq=qq+1 cx=1 endif vx=(ca[x]["x"]-mnx) vy=(mxy-ca[x]["y"]) wy=ca[x]["y"]-mny ppl[qq][cx][1]=ldmath.FixDecimal (vx/ss 4) ppl[qq][cx][2]=LDMath.FixDecimal (vy/ss 4) If vx>=0 And vy>=0 then ln[cx]="G90 X"+ldmath.FixDecimal(vx/sfc 4)+" Y"+ldmath.FixDecimal(vy/sfc 4) endif cx=cx+1 EndFor 'TextWindow.WriteLine (qq) For x=1 To qq ply[xs]=LDShapes.AddPolygon (ppl[x]) LDShapes.PenWidth(ply[xs],1) Shapes.SetOpacity (ply[xs], 40) LDShapes.BrushColour (ply[xs],"gray") LDShapes.PenColour (ply[xs],"black") xs=xs+1 EndFor ' TextWindow.WriteLine (ln) LDEvents.MouseWheel =mww zzl=1 EndSub Sub rmn lm= LDDialogs.LastRightClickMenuItem If lm=1 Then GraphicsWindow.Clear () unset() annlz () elseif lm=2 then pltm="true elseif lm=3 then pau=not[pau] elseif lm=4 then pp=LDCommPort.OpenPort("COM3" 115200) elseif lm=5 then TextWindow.Write (">> Home: ") rr=LDCommPort.TXString ("G90 X0 Y0"+nln) TextWindow.WriteLine (rr) elseif lm=6 then qx=ac TextWindow.WriteLine ("_______ABORTED_________") pau="false elseif lm=7 then rr=LDCommPort.TXString ("?"+nln) rd=LDCommPort.RXAll() TextWindow.WriteLine (rd) Else LDCommPort.ClosePort () EndIf EndSub Sub mdd If Mouse.IsLeftButtonDown Then sc=zzl LDGraphicsWindow.Reposition (zzl zzl ldGraphicsWindow.RepositionedMouseX/sc-100/sc ldGraphicsWindow.RepositionedMouseY/sc-100/sc aa) EndIf EndSub Sub chkmm For x=1 To Array.GetItemCount (ll)-1 sst=Text.GetSubText (ll[x],1,2) If Text.IsSubText("PU PD", sst) Then If sst="PU" then uc=uc+1 Else dc=dc+1 endif tt=Text.GetSubTextToEnd (ll[x],3) cc= LDText.Split (tt,",") mnx=math.Min(mnx cc[1]) mny=math.Min(mny cc[2]) mxx=math.Max(mxx cc[1]) mxy=math.Max(mxy cc[2]) endif EndFor endsub Sub mww If Mouse.IsRightButtonDown Then aa=aa+ LDEvents.LastMouseWheelDelta*3 else zzl=zzl+ LDEvents.LastMouseWheelDelta/10 endif LDGraphicsWindow.Reposition (zzl zzl ldGraphicsWindow.RepositionedMouseX/sc-100/sc ldGraphicsWindow.RepositionedMouseY/sc-100/sc aa) endsub End>QMG224.sb< Start>QMK250.sb< ' Digital & Analog stop watch by NaochanON init() analogview() Controls.ButtonClicked=Secondhand Sub Secondhand nm= Controls.GetButtonCaption(Controls.LastClickedButton) If nm="Start" Then TF="True" Controls.SetButtonCaption(start,"Pause") t0=clock.ElapsedMilliseconds st=0 Elseif nm="Pause" then st=t1 ' sum up time TF="False" Controls.SetButtonCaption(start,"Resume") Elseif nm="Resume" then TF="True" t0=clock.ElapsedMilliseconds Controls.SetButtonCaption(start,"Pause") Elseif nm="Stop" then TF="False" j=0.00 Shapes.SetText(dtime,j) Shapes.Move(sSH,X0,Y0) Shapes.Rotate(sSH,0) Controls.SetButtonCaption(start,"Start") EndIf While TF="true" t1=Clock.ElapsedMilliseconds-t0+st J=Math.Round(t1/10)/100 x3=GW/2+R*math.Cos(Math.GetRadians(j*6-90))/2-1.5 Y3=GH/2+R*math.sin(Math.GetRadians(j*6-90))/2-GH/4+20 Shapes.Move(sSH,x3,y3) Shapes.Rotate(sSH,6*j) Shapes.SetText(dtime,j) EndWhile EndSub Sub init GW=900 GH=700 GraphicsWindow.Width=GW GraphicsWindow.Height=GH GraphicsWindow.Top = 10 GraphicsWindow.Left = 10 GraphicsWindow.Title = "Stop Watch" GraphicsWindow.BackgroundColor = "Lightcyan" Start=controls.AddButton("Start",GW-100,20) Controls.SetSize(start,80,35) Stop=controls.AddButton("Stop",GW-100,60) Controls.SetSize(stop,80,35) R=(GH-80)/2 sSH=Shapes.AddTriangle(-3,R,0,0,3,R) ' Second hand X0=GW/2-1.5 Y0=40 Shapes.Move(sSH,X0,Y0) GraphicsWindow.FontSize=20 dtime=shapes.AddText("00.00") ' digital second Shapes.Move(dtime,GW-200,25) GraphicsWindow.FontSize=16 EndSub Sub AnalogView GraphicsWindow.penColor= "red" GraphicsWindow.BrushColor= "red" cntr=Shapes.AddEllipse(14,14) Shapes.Move(cntr,(GW-14)/2,(GH-14)/2) For i = 1 To 60 If Math.Remainder(i,5)=0 Then GraphicsWindow.BrushColor= "red" GraphicsWindow.PenColor = "Red" PW=2 Else GraphicsWindow.BrushColor= "Navy" GraphicsWindow.PenColor = "Navy" PW=1 EndIf mark[i]=Shapes.AddRectangle(5*PW,5) NMB[i]=Shapes.Addtext(i) x=GW/2-5+R*math.Cos(Math.GetRadians(6*i-90)) y=GH/2+R*math.Sin(Math.GetRadians(6*i-90)) Shapes.Move(mark[i],x,y) Shapes.Rotate(mark[i],6*i-90) x2=GW/2+(R+20)*math.Cos(Math.GetRadians(6*i-90)) y2=GH/2+(R+20)*math.Sin(Math.GetRadians(6*i-90)) Shapes.Move(NMB[i],x2-10,y2-5) EndFor EndSub End>QMK250.sb< Start>QMK971.sb< TextWindow.Write("Bitte eine Nachricht eingeben: ") Nachricht = TextWindow.Read() Nachrichtklein = Text.ConvertToLowerCase(Nachricht) Nachrichtgross = Text.ConvertToUpperCase(Nachricht) TextWindow.WriteLine(Nachricht) TextWindow.WriteLine(Nachrichtklein) TextWindow.WriteLine(Nachrichtgross) End>QMK971.sb< Start>QMN494-0.sb< '____________________________________________________________________ POSITION SOURIS / CLAVIER / _______________________________________________ ' Standard code for hooking up key, mouse, and text input actions to the graphics window. GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.MouseMove = OnMouseMove GraphicsWindow.MouseUp = OnMouseUp GraphicsWindow.TextInput = OnTextInput ' moved here '__________________________________ LANCEMENT DES ROUTINES DE BASE _________________________________________ LOADIMAGES() clear_shapes() DEBUT() '______________________________________________________________________________________________ ' moved here '__________________________________ BOUCLE PRINCIPALE _________________________________________ while "true" ' BOUCLE_PRINCIPALE : ' BONUSOISEAUX() CERISES__1() rebond() ' *************** added CollisionCheck() ' *************** added Program.Delay(frequence_du_jeu) endwhile ' Goto BOUCLE_PRINCIPALE ' '______________________________________________________________________________________________ Sub OnKeyDown ' Code for key presses goes here. GraphicsWindow.Title = "'" + GraphicsWindow.LastKey + "' pressed" EndSub Sub OnKeyUp ' Code for key releases goes here. GraphicsWindow.Title = "'" + GraphicsWindow.LastKey + "' released" EndSub Sub OnMouseDown ' Code for mouse button presses goes here. If Mouse.IsLeftButtonDown Then GraphicsWindow.Title = "Left button pressed" ElseIf Mouse.IsRightButtonDown Then GraphicsWindow.Title = "Right button pressed" Else GraphicsWindow.Title = "Some mouse button pressed (other than left and right)" EndIf EndSub Sub OnMouseMove ' Code for mouse moves goes here. ' GraphicsWindow.MouseX and GraphicsWindow.MouseY are relative to the graphics window. ' Mouse.MouseX and Mouse.MouseY are relative to the entire screen, which is typically bigger than the graphics window. GraphicsWindow.Title = "GWX = " + GraphicsWindow.MouseX + ", GWY = " + GraphicsWindow.MouseY + ", ScreenX = " + Mouse.MouseX + ", ScreenY = " + Mouse.MouseY EndSub Sub OnMouseUp ' Code for mouse button releases goes here. GraphicsWindow.Title = "Some mouse button released" EndSub Sub OnTextInput ' Code for text inputs goes here. EndSub '_______________________________________________________________________________________________________________________________________________________ '__________________________________ CHARGEMENT DES ELEMENTS DE DECO ET SPRITES _________________________________________ Sub LOADIMAGES 'PATCH="D:\SMALL BASIC AUTRES JEUX\PLATEFORME 1\DECORS\" GraphicsWindow.BackgroundColor="black" GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "WHITE" GraphicsWindow.DrawText(240, 200, "Please wait while images are") GraphicsWindow.DrawText(190, 300, "downloaded from the Internet...") PATCH="http://www.ctv-production.com/smallbasic/JEUPLATEFORME/DECORS/" 'PATCH= Program.Directory+"\" GraphicsWindow.Hide() PERSONNAGE_PRINCIPAL= ImageList.LoadImage(PATCH + "ACTOR.png") ACTOR = Shapes.AddImage(PERSONNAGE_PRINCIPAL) Wact= ImageList.GetWidthOfImage(PERSONNAGE_PRINCIPAL)*2/3 '*************** added BONUSOISEAU1= ImageList.LoadImage(PATCH + "OISEAU.png") OISEAU1 = Shapes.AddImage(BONUSOISEAU1) HBON= ImageList.GetHeightOfImage(BONUSOISEAU1) '*************** added FRUITSCERISE= ImageList.LoadImage(PATCH + "CERISES.png") CERISES1 = Shapes.AddImage(FRUITSCERISE) endsub '______________________________________________________________________________________________ '__________________________________ EFFACEMENT DES ELEMENTS A ANIMER _________________________________________ Sub clear_shapes Shapes.Move(ACTOR,0,-2000) Shapes.Move(OISEAU1,0,-2000) Shapes.Move(CERISES1,0,-2000) EndSub '______________________________________________________________________________________________ '__________________________________ INITIALISATION DU JEU_________________________________________ Sub DEBUT GraphicsWindow.Show() GraphicsWindow.left=0 GraphicsWindow.top=0 GraphicsWindow.Width = "1024" GraphicsWindow.Height = "576" GraphicsWindow.Left=0.5*(Desktop.Width-GraphicsWindow.Width) GraphicsWindow.top=0.5*(Desktop.Height-GraphicsWindow.Height) background = ImageList.LoadImage(PATCH + "FOND LEVEL 1.jpg") GraphicsWindow.DrawImage(background, 0, 0) 'GraphicsWindow.Title = "Platform-programed by E.P" GraphicsWindow.KeyDown = CLAVIER frequence_du_jeu = 50 x=490 y=420 OX1=1030 OY1=700 CERX1=355 CERY1=280 ZCER1=0.6 Shapes.Move(ACTOR,x,y) Shapes.Move(OISEAU1,OX1,OY1) Shapes.Move(CERISES1,CERX1,CERY1) endsub '______________________________________________________________________________________________ '__________________________________ DEPLACEMENT PLAYER PRINCIPAL _________________________________________ Sub CLAVIER If (GraphicsWindow.LastKey = "Right") Then slidedroite() EndIf If (GraphicsWindow.LastKey = "Left") Then slidegauche() EndIf If (GraphicsWindow.LastKey = "Space") Then flag=1 DY=1 EndIf endsub Sub slidedroite GraphicsWindow.Title = "x = " + x + ", y = " + y x = x+10 y=y Shapes.Move(ACTOR,x,y) If x>910 Then x=910 endif endsub Sub slidegauche GraphicsWindow.Title = "x = " + x + ", y = " + y x = x-10 y=y Shapes.move(ACTOR,x,y) If x<10 Then x=10 endif endsub Sub rebond ' It changed as follows. If flag=1 Then NN=NN+1*DY x=x y = 450-25-10*NN Shapes.Move(ACTOR,x,y) If NN>=10 Then DY=-1 EndIf If NN<0 Then flag=0 EndIf Endif endsub '______________________________________________________________________________________________ '__________________________________ BONUS OISEAUX _________________________________________ sub BONUSOISEAUX Shapes.Move(OISEAU1,OX1,OY1+300) OX1=OX1-4 OY1=-20 * math.sin (8*OX1) If OX1<-80 Then OX1=1030 endif endsub '______________________________________________________________________________________________ '__________________________________ CERISES 1 _________________________________________ sub CERISES__1 Shapes.Move(CERISES1,CERX1,CERY1) Shapes.Zoom(CERISES1,ZCER1,ZCER1) ZCER1=ZCER1+0.02 If ZCER1>1 Then ZCER1=0.6 endif EndSub '______________________________________________________________________________________________ Sub CollisionCheck ' added this code If flag=1 Then If (x=nSprite then ' ibonus=1 ' endif 'endsub 'Sub resetPositionbonus ' spriteX[ibonus] = GraphicsWindow.Width+spriteW+Math.GetRandomNumber(GraphicsWindow.Width+2*spriteW) ' spriteY[ibonus] = spriteH+Math.GetRandomNumber(GraphicsWindow.Height-2*spriteH) 'EndSub End>QMN494-0.sb< Start>QMN494.sb< '____________________________________________________________________ POSITION SOURIS / CLAVIER / _______________________________________________ ' Standard code for hooking up key, mouse, and text input actions to the graphics window. GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.MouseMove = OnMouseMove GraphicsWindow.MouseUp = OnMouseUp GraphicsWindow.TextInput = OnTextInput Sub OnKeyDown ' Code for key presses goes here. GraphicsWindow.Title = "'" + GraphicsWindow.LastKey + "' pressed" EndSub Sub OnKeyUp ' Code for key releases goes here. GraphicsWindow.Title = "'" + GraphicsWindow.LastKey + "' released" EndSub Sub OnMouseDown ' Code for mouse button presses goes here. If Mouse.IsLeftButtonDown Then GraphicsWindow.Title = "Left button pressed" ElseIf Mouse.IsRightButtonDown Then GraphicsWindow.Title = "Right button pressed" Else GraphicsWindow.Title = "Some mouse button pressed (other than left and right)" EndIf EndSub Sub OnMouseMove ' Code for mouse moves goes here. ' GraphicsWindow.MouseX and GraphicsWindow.MouseY are relative to the graphics window. ' Mouse.MouseX and Mouse.MouseY are relative to the entire screen, which is typically bigger than the graphics window. GraphicsWindow.Title = "GWX = " + GraphicsWindow.MouseX + ", GWY = " + GraphicsWindow.MouseY + ", ScreenX = " + Mouse.MouseX + ", ScreenY = " + Mouse.MouseY EndSub Sub OnMouseUp ' Code for mouse button releases goes here. GraphicsWindow.Title = "Some mouse button released" EndSub Sub OnTextInput ' Code for text inputs goes here. EndSub '_______________________________________________________________________________________________________________________________________________________ '__________________________________ LANCEMENT DES ROUTINES DE BASE _________________________________________ LOADIMAGES() clear_shapes() DEBUT() '______________________________________________________________________________________________ '__________________________________ CHARGEMENT DES ELEMENTS DE DECO ET SPRITES _________________________________________ Sub LOADIMAGES 'PATCH="D:\SMALL BASIC AUTRES JEUX\PLATEFORME 1\DECORS\" GraphicsWindow.BackgroundColor="black" GraphicsWindow.FontSize = 40 GraphicsWindow.BrushColor = "WHITE" GraphicsWindow.DrawText(240, 200, "Please wait while images are") GraphicsWindow.DrawText(190, 300, "downloaded from the Internet...") PATCH="http://www.ctv-production.com/smallbasic/JEUPLATEFORME/DECORS/" GraphicsWindow.Hide() PERSONNAGE_PRINCIPAL= ImageList.LoadImage(PATCH + "ACTOR.png") ACTOR = Shapes.AddImage(PERSONNAGE_PRINCIPAL) BONUSOISEAU1= ImageList.LoadImage(PATCH + "OISEAU.png") OISEAU1 = Shapes.AddImage(BONUSOISEAU1) FRUITSCERISE= ImageList.LoadImage(PATCH + "CERISES.png") CERISES1 = Shapes.AddImage(FRUITSCERISE) endsub '______________________________________________________________________________________________ '__________________________________ EFFACEMENT DES ELEMENTS A ANIMER _________________________________________ Sub clear_shapes Shapes.Move(ACTOR,0,-2000) Shapes.Move(OISEAU1,0,-2000) Shapes.Move(CERISES1,0,-2000) EndSub '______________________________________________________________________________________________ '__________________________________ INITIALISATION DU JEU_________________________________________ Sub DEBUT GraphicsWindow.Show() GraphicsWindow.left=0 GraphicsWindow.top=0 GraphicsWindow.Width = "1024" GraphicsWindow.Height = "576" GraphicsWindow.Left=0.5*(Desktop.Width-GraphicsWindow.Width) GraphicsWindow.top=0.5*(Desktop.Height-GraphicsWindow.Height) background = ImageList.LoadImage(PATCH + "FOND LEVEL 1.jpg") GraphicsWindow.DrawImage(background, 0, 0) 'GraphicsWindow.Title = "Platform-programed by E.P" GraphicsWindow.KeyDown = CLAVIER frequence_du_jeu = 50 x=490 y=420 OX1=1030 OY1=700 CERX1=355 CERY1=280 ZCER1=0.6 Shapes.Move(ACTOR,x,y) Shapes.Move(OISEAU1,OX1,OY1) Shapes.Move(CERISES1,CERX1,CERY1) endsub '______________________________________________________________________________________________ '__________________________________ DEPLACEMENT PLAYER PRINCIPAL _________________________________________ Sub CLAVIER If (GraphicsWindow.LastKey = "Right") Then slidedroite() EndIf If (GraphicsWindow.LastKey = "Left") Then slidegauche() EndIf If (GraphicsWindow.LastKey = "Space") Then rebond() EndIf endsub Sub slidedroite GraphicsWindow.Title = "x = " + x + ", y = " + y x = x+10 y=y Shapes.Move(ACTOR,x,y) If x>910 Then x=910 endif endsub Sub slidegauche GraphicsWindow.Title = "x = " + x + ", y = " + y x = x-10 y=y Shapes.move(ACTOR,x,y) If x<10 Then x=10 endif endsub Sub rebond For i = 1 To 80 Step 0.01 GraphicsWindow.Title = "x = " + x + ", y = " + y x=x y = 450-25-100*Math.Abs(Math.Sin(i/25)) Shapes.Move(ACTOR,x,y) EndFor endsub '______________________________________________________________________________________________ '__________________________________ BOUCLE PRINCIPALE _________________________________________ BOUCLE_PRINCIPALE : BONUSOISEAUX() CERISES__1() Program.Delay(frequence_du_jeu) Goto BOUCLE_PRINCIPALE '______________________________________________________________________________________________ '__________________________________ BONUS OISEAUX _________________________________________ sub BONUSOISEAUX Shapes.Move(OISEAU1,OX1,OY1+300) OX1=OX1-4 OY1=-20 * math.sin (8*OX1) If OX1<-80 Then OX1=1030 endif endsub '______________________________________________________________________________________________ '__________________________________ CERISES 1 _________________________________________ sub CERISES__1 Shapes.Move(CERISES1,CERX1,CERY1) Shapes.Zoom(CERISES1,ZCER1,ZCER1) ZCER1=ZCER1+0.02 If ZCER1>1 Then ZCER1=0.6 endif EndSub '______________________________________________________________________________________________ 'à mettre dans le chargement des sprites au début 'spriteImage = ImageList.LoadImage(PGD+"BONUSLOGOSOFA.png") '"http://www.ctv-production.com/smallbasic/jeusofa/SPRITES/BONUSLOGOSOFA.png") 'For ibonus = 1 To nSprite 'spritebonus[ibonus] = Shapes.AddImage(spriteImage) 'EndFor 'EndSub 'nsprite=4 'à mettre au départ 'Sub MVTBONUS ' ibonus=ibonus+1 ' ROTBONUS=ROTBONUS+2 ' Shapes.Rotate(spritebonus[ibonus],ROTBONUS) ' spriteX[ibonus] = spriteX[ibonus]-speedbonus ' Shapes.Move(spritebonus[ibonus],spriteX[ibonus]-spriteW,250) ' If (spriteX[ibonus] < -spriteW) Then ' resetPositionbonus() ' EndIf ' If ibonus>=nSprite then ' ibonus=1 ' endif 'endsub 'Sub resetPositionbonus ' spriteX[ibonus] = GraphicsWindow.Width+spriteW+Math.GetRandomNumber(GraphicsWindow.Width+2*spriteW) ' spriteY[ibonus] = spriteH+Math.GetRandomNumber(GraphicsWindow.Height-2*spriteH) 'EndSub End>QMN494.sb< Start>QMN689.sb< '############################################################################## ' Programm: Beispiel Zahleneingabe ' erstellt: 11.06.2013 ' Ersteller: Martin Menze ' martmen@gmx.de '############################################################################## ' Beschreibung: ' Das Programm dient als Beispiel für eine Eingabe von Zahlen. Die meisten nicht für Zahlen zu verwendenden ' Zeichen stehen der Eingabe nicht zur Verfügung. Die erlaubten Zeichen stehen im array Number. ' Das Eingabefeld wird mit vor der Eingabe mit Leerzeichen gefüllt, so dass die Eingabe wie bei Zahlen üblich ' am rechten Rand der Eingabe beginnt. Besteht das Eingabefeld aus mehr als der vordefinierten Länge, so ' wird es auf diese wieder gebracht. ' Die Eingabe wird mit Return, Tab oder durch Setzen des Cursors in ein anderes Feld abgeschlossen. '############################################################################## '**************************************************************************************************************** ' Ereignisse GraphicsWindow.KeyUp = OnKeyUp 'Wird eine Taste gedrückt und losgelassen startet Sub OnKeyUP Controls.ButtonClicked = OnButtonClicked 'Wird ein Button angeklickt startet Sub OnButtonClicked ' Initialisierung Init() ' Hauptprogrogramm Main() ' Programmende Program.End() '**************************************************************************************************************** Sub Main MainLoop = T 'MainLoop wird mit True gefüllt While MainLoop = T 'Solange MainLoop mit True gefüllt ist, wird die Schleife durchlaufen BeforeInputNumber() 'Vor der Nummerneingabe wird die Eingabe vorbereitet InputNumber() 'Eingabe einer Nummer AfterInputNumber() 'Nach der Nummerneingabe wird der eingegebene Wert verarbeitet BeforeInputText() 'Vor der Texteingabe wird die Eingabe vorbereitet InputText() 'Eingabe eines Textex AfterInputText() 'Nach der Texteingabe wird der Text verarbeitet EndWhile EndSub 'Main '********************************************************************************************************** '############################################################################## '# Der Button " E N D E " unsichtbar machen. Die Textbox mit dem Wert aus INPUT vorbelegen. Den Cursor # '# in die Textbox stellen. Den Cursor an das Ende des Wertes in der Textbox stellen. '############################################################################## Sub BeforeInputNumber Controls.HideControl(BT[1]) Controls.SetTextBoxText(TB[1], INPUT)' LDFocus.SetFocus(TB[1]) LDControls.SetCursorToEnd(TB[1]) EndSub 'BeforeInputNumber '############################################################################## '# Das Feld InputLoop wird mit "True" aus T belegt. Solange der Wert von InputLoop "True" ist wird die # '# Schleife durchlauften. '# Wurde eine Taste losgelassen (OKU = "True", dann mach folgendes: '# - Setz den Wert von OKU auf "False" '# - Ruf die Subroutine ClearLeer auf '# - Ruf die Subroutine CheckLastKey auf '# Ende des Teils für Taste losgelassen '# In im Feld InputLoop eine Fragezeichen dann mach folgendes: '# ... '############################################################################## Sub InputNumber InputLoop = T While InputLoop = T If OKU = T Then OKU = F ClearLeer() CheckLastKey() EndIf If InputLoop = "?" Then Zahl1 = InputNoSpace Zahl2 = Zahl1 + 0 If (Zahl1 = Zahl2) Then InputLoop = F Else Controls.SetTextBoxText(TB[1], Text.GetSubText(INPUT, 1, Text.GetLength(INPUT) - 1)) LDControls.SetCursorToEnd(TB[1]) InputLoop = T GraphicsWindow.BrushColor = "Orange" 'GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle(9,GraphicsWindow.Height - 31, 400, 25) GraphicsWindow.BrushColor = BrushColor GraphicsWindow.DrawText(10,GraphicsWindow.Height - 30, "Berichtigen Sie die Zahl, sie ist nicht gültig!") EndIf Endif EndWhile EndSub 'InputNumber '############################################################################## '############################################################################## Sub ClearLeer INPUT = Controls.GetTextBoxText(TB[1]) InputNoSpace = INPUT While Text.GetSubText(InputNoSpace, 1, 1) = "_" InputLen = Text.GetLength(InputNoSpace) InputNoSpace = Text.GetSubText(InputNoSpace, 2, InputLen - 1) EndWhile INPUT = Leer + InputNoSpace EndSub 'ClearLeer '############################################################################## '############################################################################## Sub CheckLastKey LK = GraphicsWindow.LastKey If Array.ContainsValue(Number, LK) = F Then Controls.SetTextBoxText(TB[1], Text.GetSubText(INPUT, 1, Text.GetLength(INPUT) - 1)) LDControls.SetCursorToEnd(TB[1]) ElseIf LK = "Return" Then InputLoop = "?" EndIf EndSub 'CheckLastKey '############################################################################## '############################################################################## Sub AfterInputNumber GraphicsWindow.BrushColor = "Yellow" 'GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle(219,9, 400, 60) GraphicsWindow.BrushColor = BrushColor GraphicsWindow.DrawText(220, 10, INPUT) GraphicsWindow.DrawText(220, 30, InputNoSpace) EndSub 'AfterInpunNumber '############################################################################## '############################################################################## Sub BeforeInputText Controls.ShowControl(BT[1]) Controls.SetTextBoxText(TB[2], Text) LDFocus.SetFocus(TB[2]) EndSub 'BeforeInputText '############################################################################## '############################################################################## Sub InputText InputLoop = T While InputLoop = T If OKU = T Then LK = GraphicsWindow.LastKey If LK = "Return" Then Text = Controls.GetTextBoxText(TB[1]) InputLoop = F EndIf EndIf OKU = F CheckButton() EndWhile EndSub 'InputText '############################################################################## '############################################################################## Sub AfterInputText Text = Controls.GetTextBoxText(TB[2]) GraphicsWindow.DrawText(220, 80, Text) EndSub 'AfterInputText '############################################################################## '############################################################################## Sub CheckButton If OBC = T Then OBC = F LCB = Controls.LastClickedButton If LCB = BT[1] Then InputLoop = F MainLoop = F EndIf EndIf EndSub 'CheckButton '############################################################################## '############################################################################## Sub Init T = "True" F = "False" BrushColor = GraphicsWindow.BrushColor BT[1] = Controls.AddButton(" E N D E ", GraphicsWindow.Width / 2 + 40, GraphicsWindow.Height - 30) Number[1] = "D1" Number[2] = "D2" Number[3] = "D3" Number[4] = "D4" Number[5] = "D5" Number[6] = "D6" Number[7] = "D7" Number[8] = "D8" Number[9] = "D9" Number[10] = "D0" Number[11] = "NumPad1" Number[12] = "NumPad2" Number[13] = "NumPad3" Number[14] = "NumPad4" Number[15] = "NumPad5" Number[16] = "NumPad6" Number[17] = "NumPad7" Number[18] = "NumPad8" Number[19] = "NumPad9" Number[20] = "NumPad0" Number[21] = "," Number[22] = "." Number[23] = "Delete" Number[24] = "Back" Number[25] = "Up" Number[26] = "Down" Number[27] = "Subtract" Number[28] = "OemMinus" Number[29] = "OemComma" Number[30] = "Decimal" Number[31] = "F1" Number[32] = "F2" Number[33] = "F3" Number[34] = "F4" Number[35] = "F5" Number[36] = "F6" Number[37] = "F7" Number[38] = "F8" Number[39] = "F9" Number[40] = "System" Number[41] = "F11" Number[42] = "F12" Number[43] = "Escape" Number[44] = "Tab" Number[45] = "Capital" Number[46] = "LeftShift" Number[47] = "RightShift" Number[48] = "LeftCtrl" Number[49] = "RightCtrl" Number[50] = "LeftAlt" Number[51] = "RightAlt" Number[52] = "LWin" Number[53] = "RWin" Number[54] = "Return" Leer = "_________________________" ChrWidth = 200 / 54 TB[1] = Controls.AddTextBox(10,10) Controls.SetSize(TB[1], 200, 22) INPUT = Leer + InputNoSpace TB[2] = Controls.AddTextBox(10,80) Text = "" Zahl1 = 1 Zahl2 = 1 EndSub 'Init '############################################################################## '############################################################################## Sub OnKeyUp OKU = T EndSub 'OnKeyUp '############################################################################## '############################################################################## Sub OnButtonClicked OBC = T EndSub 'OnButtonClicked End>QMN689.sb< Start>QMP561.sb< im=ImageList.LoadImage ("e:\ann.png") GraphicsWindow.BackgroundColor="teal ss=LDShapes.AddAnimatedImage(im "true" 12 4) Shapes.Move (ss 300 0) GraphicsWindow.Title ="Roundwalk d1200=1200 GraphicsWindow.Left=10 GraphicsWindow.Top=10 GraphicsWindow.Width=1600 GraphicsWindow.Height=900 d300=100 dd=50 While "true lk= GraphicsWindow.LastKey If lk="Down" then LDShapes.AnimationSet (ss 1) Shapes.Animate (ss LDShapes.GetLeft(ss) LDShapes.GetTop(ss)+d300 1200) Program.Delay (d1200) Shapes.AddLine (LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)+dd LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)-d300+dd) ElseIf lk="Left" then LDShapes.AnimationSet (ss 13) Shapes.Animate (ss ldshapes.getLeft(ss)-d300 LDShapes.GetTop(ss) 1200) Program.Delay (d1200) Shapes.AddLine (LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)+dd LDShapes.GetLeft(ss)+d300+dd LDShapes.GetTop(ss)+dd) elseif lk="Up" then LDShapes.AnimationSet(ss 37) Shapes.Animate (ss ldshapes.GetLeft(ss) LDShapes.GetTop(ss)-d300 1200) Program.Delay (d1200) Shapes.AddLine (LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)+dd LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)+d300+dd) else LDShapes.AnimationSet(ss 25) Shapes.Animate (ss ldshapes.GetLeft(ss)+d300 LDShapes.GetTop(ss) 1200) Program.Delay (d1200) Shapes.AddLine (LDShapes.GetLeft(ss)+dd LDShapes.GetTop(ss)+dd LDShapes.GetLeft(ss)-d300+dd LDShapes.GetTop(ss)+dd) EndIf If LDShapes.GetLeft (ss)<0 Then LDShapes.Move (ss 1600 LDShapes.GetTop (ss)) ElseIf LDShapes.GetLeft (ss)>1600 Then LDShapes.Move (ss 00 LDShapes.GetTop (ss)) EndIf EndWhile End>QMP561.sb< Start>QMS609-0.sb< ' Orionid ' Version 0.2 ' オリオン座流星群 ' Copyright © 2016-2017 Nonki Takahshi. The MIT License. ' Last update 2017-10-16 ' Program ID QMS609-0 ' ' Reference: ' http://en.wikipedia.org/wiki/List_of_stars_in_Orion title = "Orionid" r = 600 ' [px] delay = 100 ' [ms] Init() Cal_Init() InitStars() ra = radiant["ra"] dec = radiant["dec"] Mapping() rot = ra tilt = dec - 5 GraphicsWindow.Title = title + " RA=" + ra + "h Dec=" + dec + "°" DrawRA() DrawDec() Shapes_Init() scale = 1 iMin = 1 iMax = Array.GetItemCount(shape) Shapes_Add() DrawEcliptic() DrawStars() DrawCalendar() DrawMeteorShower() While "True" If keyDown Then If key = "Right" Then rot = rot + 0.25 If 24 <= rot Then rot = rot - 24 EndIf ElseIf key = "Left" Then rot = rot - 0.25 If rot < 0 Then rot = rot + 24 EndIf ElseIf key = "Up" Then If tilt <= 85 Then tilt = tilt + 5 EndIf ElseIf key = "Down" Then If -85 <= tilt Then tilt = tilt - 5 EndIf ElseIf key = "Add" Then r = r * 1.2 ElseIf key = "Subtract" Then r = r / 1.2 EndIf GraphicsWindow.Title = title + " RA=" + rot + "h Dec=" + tilt + "°" GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillRectangle(0, 0, gw, gh) DrawRA() DrawDec() DrawEcliptic() DrawStars() keyDown = "False" EndIf Program.Delay(delay) EndWhile Sub Init gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "Black" ox = gw / 2 oy = gh * 0.35 rot = 0 ' rotation tilt = 0 monthX = 40 monthY = 20 calendarX = 40 calendarY = gh - 180 year = 2017 month = 10 GraphicsWindow.KeyDown = OnKeyDown EndSub Sub OnKeyDown keyDown = "True" key = GraphicsWindow.LastKey EndSub Sub DrawRA GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#666666" roll = 0 For ra = 0 To 23 For dec = -90 To 90 Step 5 Mapping() If -90 < dec Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndFor EndSub Sub DrawDec GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#666666" roll = 0 For dec = -80 To 80 Step 10 For ra = 0 To 24 Step 0.2 Mapping() If 0 < ra Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndFor EndSub Sub DrawEcliptic GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#999900" roll = 23.26 dec = 0 For ra = 0 To 24 Step 0.2 Mapping() If 0 < ra Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndSub Sub DrawLine visible = "False" If 0 <= z And 0 <= zLast Then If 0 <= x And x < gw And 0 <= y And y < gh Then visible = "True" ElseIf 0 <= xLast And xLast < gw And 0 <= yLast And yLast < gh Then visible = "True" EndIf EndIf If visible Then GraphicsWindow.DrawLine(xLast, yLast, x, y) EndIf EndSub Sub DrawStars GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "White" n = Array.GetItemCount(star) index = Array.GetAllIndices(star) roll = 0 For i = 1 To n ra = star[index[i]]["ra"] dec = star[index[i]]["dec"] Mapping() If ell[index[i]] <> "" Then Shapes.Remove(ell[index[i]]) ell[index[i]] = "" EndIf If 0 <= z Then mag = star[index[i]]["mag"] d = 16 / (mag + 3) ell[index[i]] = Shapes.AddEllipse(d, d) Shapes.Move(ell[index[i]], x - d / 2, y - d / 2) EndIf EndFor GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "LightGray" nSign = Array.GetItemCount(edge) iSign = Array.GetAllIndices(edge) For j = 1 To nSign n = Array.GetItemCount(edge[iSign[j]]) index = Array.GetAllIndices(edge[iSign[j]]) For i = 1 To n e = edge[iSign[j]][index[i]] m = Text.GetIndexOf(e, "-") ra = star[Text.GetSubText(e, 1, m - 1)]["RA"] dec = star[Text.GetSubText(e, 1, m - 1)]["Dec"] Mapping() x1 = x y1 = y z1 = z ra = star[Text.GetSubTextToEnd(e, m + 1)]["RA"] dec = star[Text.GetSubTextToEnd(e, m + 1)]["Dec"] Mapping() x2 = x y2 = y z2 = z If connect[iSign[j]][index[i]] <> "" Then Shapes.Remove(connect[iSign[j]][index[i]]) connect[iSign[j]][index[i]] = "" EndIf visible = "False" If 0 <= z1 And 0 <= z2 Then If 0 <= x1 And x1 <= gw And 0 <= y1 And y1 <= gh Then visible = "True" ElseIf 0 <= x2 And x2 <= gw And 0 <= y2 And y2 <= gh Then visible = "True" EndIf If visible Then connect[iSign[j]][index[i]] = Shapes.AddLine(x1, y1, x2, y2) EndIf EndIf EndFor ' i EndFor ' j EndSub Sub DrawMeteorShower ra = radiant["RA"] dec = radiant["Dec"] Mapping() rx = x ry = y GraphicsWindow.PenColor = "White" While "True" Program.Delay(2000) angle = Math.GetRandomNumber(360) _a = Math.GetRadians(angle) r1 = Math.GetRandomNumber(100) + 50 r2 = r1 * 2.5 x1 = rx + r1 * Math.Sin(_a) y1 = ry - r1 * Math.Cos(_a) x2 = rx + r2 * Math.Sin(_a) y2 = ry - r2 * Math.Cos(_a) meteor = Shapes.AddLine(x1, y1, x2, y2) For op = 100 To 0 Step -5 Shapes.SetOpacity(meteor, op) Program.Delay(50) EndFor Shapes.Remove(meteor) EndWhile EndSub Sub DrawCalendar GraphicsWindow.BrushColor = "White" If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 30 txt = Shapes.AddText(months[month]) Shapes.Move(txt, monthX, monthY) If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 40 txt = Shapes.AddText(year) Shapes.Move(txt, monthX, monthY + 30) sBuf = year + "," + month Command_GetArgs() iYear = sArg[1] if iYear = "" Then Goto lEnd Endif If Math.Remainder(iYear, 4) = 0 And Math.Remainder(iYear, 100) > 0 Or Math.Remainder(iYear, 400) = 0 Then iDoM[2] = iDoM[2] + 1 Endif iNoL = Math.Floor((iYear - 1) / 4) - Math.Floor((iYear - 1) / 100) + Math.Floor((iYear - 1) / 400) ' number of leap year iWoY = Math.Remainder((iYear + iNoL), 7) ' week of year iMonth = sArg[2] If iMonth = "" Then iM0 = 1 iM1 = 12 Else iM0 = iMonth iM1 = iMonth Endif iDoY = 0 ' days of year iNoM = 1 ' number of month For iM = iM0 To iM1 While iNoM < iM iDoY = iDoY + iDoM[iNoM] iNoM = iNoM + 1 EndWhile Cal_DrawMonth() EndFor lEnd: EndSub Sub Mapping ' param ra - right asension [h] ' param rot - rotation [h] ' param dec - declination [deg] ' param tilt - tilt [deg] ' param roll - roll [deg] ' param r - radius [px] ' return x, y - position in the graphics window [px] ' return z - visible if 0 <= z If Text.IsSubText(ra, " ") Then _ra = Text.GetSubText(ra, 1, 2) _ra = _ra + Text.GetSubText(ra, 4, 2) / 60 _ra = _ra + Text.GetSubText(ra, 7, 5) / 3600 ra = _ra EndIf If Text.IsSubText(dec, " ") Then _dec = Text.GetSubText(dec, 2, 2) _dec = _dec + Text.GetSubText(dec, 5, 2) / 60 _dec = _dec + Text.GetSubText(dec, 8, 5) / 3600 _dec = _dec * Text.Append(Text.GetSubText(dec, 1, 1), "1") dec = _dec EndIf φ = Math.GetRadians(ra * 15) θ = Math.GetRadians(dec) x = ox - r * Math.Sin(φ) * Math.Cos(θ) y = oy - r * Math.Sin(θ) z = r * Math.Cos(φ) * Math.Cos(θ) If roll <> 0 Then _x = x - ox _y = y - oy ψ = Math.GetRadians(roll) x = ox + Math.Cos(ψ) * _x - Math.Sin(ψ) * _y y = oy + Math.Sin(ψ) * _x + Math.Cos(ψ) * _y EndIf If rot <> 0 Then _x = x - ox _z = z ρ = Math.GetRadians(-rot * 15) x = ox + Math.Cos(ρ) * _x - Math.Sin(ρ) * _z z = Math.Sin(ρ) * _x + Math.Cos(ρ) * _z EndIf If tilt <> 0 Then _z = z _y = y - oy τ = Math.GetRadians(tilt) z = Math.Cos(τ) * _z - Math.Sin(τ) * _y y = oy + Math.Sin(τ) * _z + Math.Cos(τ) * _y EndIf EndSub Sub InitStars ' Initialize stars in Orion ' index: Flamsteed designation ' RA (Right ascension), Dec (Declination), Mag (Apparent magnitude) star["Rigel"] = "ra=05 14 32.27;dec=-08 12 05.9;mag=0.18;fd=19;" star["Betelgeuse"] = "ra=05 55 10.29;dec=+07 24 25.3;mag=0.42;fd=58;" star["Bellatrix"] = "ra=05 25 07.87;dec=+06 20 59.0;mag=1.64;fd=24;" star["Alnilam"] = "ra=05 36 12.81;dec=-01 12 06.9;mag=1.69;fd=46;" star["Alnitak A"] = "ra=05 40 45.52;dec=-01 56 33.3;mag=1.88;fd=50;" star["Saiph"] = "ra=05 47 45.39;dec=-09 40 10.6;mag=2.07;fd=53;" star["Mintaka AB"] = "ra=05 32 00.40;dec=-00 17 56.7;mag=2.20;fd=34;" star["ι Ori"] = "ra=05 35 25.98;dec=-05 54 35.6;mag=2.75;fd=44;" star["π3 Ori"] = "ra=04 49 50.14;dec=+06 57 40.5;mag=3.19;fd=1;" star["η Ori"] = "ra=05 24 28.62;dec=-02 23 49.7;mag=3.35;fd=28;" star["Meissa A"] = "ra=05 35 08.28;dec=+09 56 03.0;mag=3.47;fd=39;" star["τ Ori"] = "ra=05 17 36.40;dec=-06 50 39.8;mag=3.59;fd=20;" star["π4 Ori"] = "ra=04 51 12.37;dec=+05 36 18.4;mag=3.68;fd=3;" star["Alnitak BC"] = "ra=05 40 45.60;dec=-01 56 34.0;mag=3.70;fd=50;" star["π5 Ori"] = "ra=04 54 15.10;dec=+02 26 26.4;mag=3.71;fd=8;" star["σ Ori AB"] = "ra=05 38 44.77;dec=-02 36 00.2;mag=3.77;fd=48;" star["ο2 Ori"] = "ra=04 56 22.32;dec=+13 30 52.5;mag=4.06;fd=9;" star["φ2 Ori"] = "ra=05 36 54.33;dec=+09 17 29.1;mag=4.09;fd=40;" star["μ Ori"] = "ra=06 02 22.99;dec=+09 38 50.5;mag=4.12;fd=61;" star["29 Ori"] = "ra=05 23 56.84;dec=-07 48 28.6;mag=4.13;fd=29;" star["32 Ori"] = "ra=05 30 47.05;dec=+05 56 53.6;mag=4.20;fd=32;" star["π2 Ori"] = "ra=04 50 36.72;dec=+08 54 00.9;mag=4.35;fd=2;" star["φ1 Ori"] = "ra=05 34 49.24;dec=+09 29 22.5;mag=4.39;fd=37;" star["χ1 Ori"] = "ra=05 54 23.08;dec=+20 16 35.1;mag=4.39;fd=54;" star["ν Ori"] = "ra=06 07 34.32;dec=+14 46 06.7;mag=4.42;fd=67;" star["ξ Ori"] = "ra=06 11 56.40;dec=+14 12 31.7;mag=4.45;fd=70;" star["ρ Ori"] = "ra=05 13 17.48;dec=+02 51 40.5;mag=4.46;fd=17;" star["π6 Ori"] = "ra=04 58 32.90;dec=+01 42 50.5;mag=4.47;fd=10;" star["ω Ori"] = "ra=05 39 11.15;dec=+04 07 17.3;mag=4.50;fd=47;" star["HD 40657"] = "ra=06 00 03.35;dec=-03 04 26.7;mag=4.53;" star["42 Ori"] = "ra=05 35 23.16;dec=-04 50 18.0;mag=4.58;fd=42;" star["ψ2 Ori"] = "ra=05 26 50.23;dec=+03 05 44.4;mag=4.59;fd=30;" star["υ Ori"] = "ra=05 31 55.86;dec=-07 18 05.5;mag=4.62;fd=36;" star["π1 Ori"] = "ra=04 54 53.70;dec=+10 09 04.1;mag=4.64;fd=7;" star["χ2 Ori"] = "ra=06 03 55.18;dec=+20 08 18.5;mag=4.64;fd=62;" star["11 Ori"] = "ra=05 04 34.14;dec=+15 24 15.1;mag=4.65;fd=11;" star["ο1 Ori"] = "ra=04 52 31.96;dec=+14 15 02.8;mag=4.71;fd=4;" star["31 Ori"] = "ra=05 29 43.98;dec=-01 05 31.8;mag=4.71;fd=31;" star["22 Ori"] = "ra=05 21 45.75;dec=-00 22 56.9;mag=4.72;fd=22;" star["56 Ori"] = "ra=05 52 26.44;dec=+01 51 18.6;mag=4.76;fd=56;" star["49 Ori"] = "ra=05 38 53.09;dec=-07 12 45.8;mag=4.77;fd=49;" star["HD 36960"] = "ra=05 35 02.68;dec=-06 00 07.3;mag=4.78;" star["15 Ori"] = "ra=05 09 41.96;dec=+15 35 50.2;mag=4.81;" star["ψ1 Ori"] = "ra=05 24 44.83;dec=+01 50 47.2;mag=4.89;fd=25;" star["51 Ori"] = "ra=05 42 28.66;dec=+01 28 28.8;mag=4.90;fd=51;" star["HD 44131"] = "ra=06 19 59.60;dec=-02 56 40.2;mag=4.91;" star["HD 37756"] = "ra=05 40 50.72;dec=-01 07 43.6;mag=4.95;" star["69 Ori"] = "ra=06 12 03.28;dec=+16 07 49.6;mag=4.95;fd=69;" star["θ2 Ori A"] = "ra=05 35 22.90;dec=-05 24 57.8;mag=4.98;fd=43;" star["23 Ori"] = "ra=05 22 50.00;dec=+03 32 40.0;mag=5.00;fd=23;" star["74 Ori"] = "ra=06 16 26.57;dec=+12 16 18.2;mag=5.04;fd=74;" star["27 Ori"] = "ra=05 24 28.91;dec=-00 53 30.0;mag=5.07;fd=27;" star["θ1 Ori C"] = "ra=05 35 16.47;dec=-05 23 22.9;mag=5.13;fd=41;" star["64 Ori"] = "ra=06 03 27.36;dec=+19 41 26.2;mag=5.14;fd=64;" star["6 Ori"] = "ra=04 54 46.91;dec=+11 25 33.5;mag=5.18;fd=6;" star["HD 33554"] = "ra=05 11 41.56;dec=+16 02 44.4;mag=5.18;" star["71 Ori"] = "ra=06 14 50.94;dec=+19 09 24.8;mag=5.20;fd=71;" star["60 Ori"] = "ra=05 58 49.58;dec=+00 33 10.7;mag=5.21;fd=60;" star["45 Ori"] = "ra=05 35 39.49;dec=-04 51 21.9;mag=5.24;fd=45;" star["52 Ori"] = "ra=05 48 00.23;dec=+06 27 15.2;mag=5.26;fd=52;" star["38 Ori"] = "ra=05 34 16.79;dec=+03 46 01.0;mag=5.32;fd=38;" star["5 Ori"] = "ra=04 53 22.76;dec=+02 30 29.8;mag=5.33;fd=5;" star["HD 31296"] = "ra=04 54 47.79;dec=+07 46 45.0;mag=5.33;" star["14 Ori"] = "ra=05 07 52.87;dec=+08 29 54.9;mag=5.33;fd=14;" star["21 Ori"] = "ra=05 19 11.23;dec=+02 35 45.4;mag=5.34;fd=21;" star["HD 36591"] = "ra=05 32 41.35;dec=-01 35 30.6;mag=5.34;" star["72 Ori"] = "ra=06 15 25.13;dec=+16 08 35.5;mag=5.34;fd=72;" star["HD 30210"] = "ra=04 46 01.70;dec=+11 42 20.2;mag=5.35;" star["VV Ori"] = "ra=05 33 31.45;dec=-01 09 21.9;mag=5.36;" star["55 Ori"] = "ra=05 51 21.98;dec=-07 31 04.8;mag=5.36;fd=55;" star["HD 30034"] = "ra=04 44 25.77;dec=+11 08 46.2;mag=5.39;" star["75 Ori"] = "ra=06 17 06.62;dec=+09 56 33.1;mag=5.39;fd=75;" star["U Ori"] = "ra=05 55 49.30;dec=+20 10 30.0;mag=5.40;" star["16 Ori"] = "ra=05 09 19.60;dec=+09 49 46.6;mag=5.43;fd=16;" star["73 Ori"] = "ra=06 15 44.97;dec=+12 33 03.9;mag=5.44;fd=73;" star["33 Ori"] = "ra=05 31 14.53;dec=+03 17 31.7;mag=5.46;fd=33;" star["HD 34043"] = "ra=05 14 44.05;dec=+05 09 22.1;mag=5.50;" star["18 Ori"] = "ra=05 16 04.14;dec=+11 20 28.9;mag=5.52;fd=18;" star["HD 35536"] = "ra=05 25 01.74;dec=-10 19 43.8;mag=5.60;" star["35 Ori"] = "ra=05 33 54.29;dec=+14 18 20.1;mag=5.60;fd=35;" star["HD 36881"] = "ra=05 35 13.24;dec=+10 14 24.4;mag=5.60;" star["HD 43318"] = "ra=06 15 34.36;dec=-00 30 42.0;mag=5.62;" star["66 Ori"] = "ra=06 04 58.36;dec=+04 09 31.2;mag=5.63;fd=66;" star["HD 36959"] = "ra=05 35 01.01;dec=-06 00 33.4;mag=5.67;" star["63 Ori"] = "ra=06 04 58.19;dec=+05 25 11.9;mag=5.67;fd=63;" star["HD 44033"] = "ra=06 20 04.23;dec=+14 39 04.2;mag=5.67;" star["HD 35007"] = "ra=05 21 31.84;dec=-00 24 59.4;mag=5.68;" star["HD 35299"] = "ra=05 23 42.31;dec=-00 09 35.3;mag=5.69;" star["HD 40369"] = "ra=05 58 53.24;dec=+12 48 29.7;mag=5.70;" star["HD 42111"] = "ra=06 08 57.90;dec=+02 29 59.0;mag=5.70;" star["HD 43587"] = "ra=06 17 16.25;dec=+05 05 58.9;mag=5.70;" star["HD 37209"] = "ra=05 36 35.69;dec=-06 03 53.1;mag=5.71;" star["68 Ori"] = "ra=06 12 01.34;dec=+19 47 26.1;mag=5.76;fd=68;" star["HD 36166"] = "ra=05 29 54.77;dec=+01 47 21.3;mag=5.77;" star["HD 34989"] = "ra=05 21 43.56;dec=+08 25 42.8;mag=5.78;" star["HD 38527"] = "ra=05 46 52.15;dec=+09 31 21.0;mag=5.78;" star["HD 31373"] = "ra=04 55 50.16;dec=+15 02 25.1;mag=5.79;" star["HD 39007"] = "ra=05 50 02.68;dec=+09 52 16.4;mag=5.79;" star["HD 36134"] = "ra=05 29 23.70;dec=-03 26 46.9;mag=5.80;" star["HD 43023"] = "ra=06 13 54.24;dec=-03 44 29.1;mag=5.83;" star["HD 42954"] = "ra=06 14 28.58;dec=+17 54 23.0;mag=5.86;" star["HD 37320"] = "ra=05 38 01.11;dec=+07 32 29.2;mag=5.87;" star["HD 39910"] = "ra=05 55 30.16;dec=-04 36 59.4;mag=5.87;" star["HD 33646"] = "ra=05 11 45.35;dec=+01 02 13.4;mag=5.88;" star["HD 33608"] = "ra=05 11 19.13;dec=-02 29 26.8;mag=5.89;" star["HD 40020"] = "ra=05 56 49.39;dec=+11 31 16.3;mag=5.89;" star["59 Ori"] = "ra=05 58 24.44;dec=+01 50 13.7;mag=5.89;fd=59;" star["HD 33833"] = "ra=05 12 48.12;dec=-06 03 25.6;mag=5.90;" star["HD 32263"] = "ra=05 01 50.35;dec=+00 43 19.8;mag=5.91;" star["HD 43112"] = "ra=06 15 08.46;dec=+13 51 03.9;mag=5.91;" star["HD 36780"] = "ra=05 34 04.06;dec=-01 28 12.7;mag=5.92;" star["57 Ori"] = "ra=05 54 56.69;dec=+19 44 58.6;mag=5.92;fd=57;" star["HD 36162"] = "ra=05 30 26.17;dec=+15 21 38.0;mag=5.93;" star["HD 37788"] = "ra=05 41 05.59;dec=+00 20 15.7;mag=5.93;" star["HD 38529"] = "ra=05 46 34.96;dec=+01 10 06.7;mag=5.94;" star["HD 39421"] = "ra=05 52 07.73;dec=-09 02 31.1;mag=5.95;" star["HD 37481"] = "ra=05 38 37.97;dec=-06 34 26.2;mag=5.96;" star["HD 39051"] = "ra=05 50 13.06;dec=+04 25 24.6;mag=5.96;" star["HD 39286"] = "ra=05 52 23.41;dec=+19 52 04.3;mag=5.96;" star["HD 37171"] = "ra=05 37 04.35;dec=+11 02 06.2;mag=5.97;" star["HD 38089"] = "ra=05 42 53.91;dec=-06 47 46.7;mag=5.97;" star["HD 38858"] = "ra=05 48 34.90;dec=-04 05 38.7;mag=5.97;" star["HD 39118"] = "ra=05 50 30.03;dec=+02 01 29.0;mag=5.97;" star["HD 39885"] = "ra=05 56 28.04;dec=+09 30 33.9;mag=5.97;" star["HD 31331"] = "ra=04 54 50.71;dec=+00 28 01.8;mag=5.98;" star["HD 35281"] = "ra=05 23 18.51;dec=-08 24 56.1;mag=5.99;" star["HD 37594"] = "ra=05 39 31.15;dec=-03 33 53.0;mag=5.99;" star["HD 39775"] = "ra=05 54 44.04;dec=+00 58 07.0;mag=5.99;" star["HD 44497"] = "ra=06 22 36.42;dec=+12 34 13.1;mag=6.00;" star["HD 37303"] = "ra=05 37 27.36;dec=-05 56 18.2;mag=6.03;" star["HD 30545"] = "ra=04 48 44.63;dec=+03 35 18.8;mag=6.04;" star["HD 32686"] = "ra=05 04 54.53;dec=-03 02 22.8;mag=6.04;" star["V1031 Ori"] = "ra=05 47 26.90;dec=-10 31 58.5;mag=6.04;" star["HD 42477"] = "ra=06 11 27.91;dec=+13 38 19.0;mag=6.04;" star["HD 43285"] = "ra=06 15 40.18;dec=+06 03 58.3;mag=6.07;" star["HD 33883"] = "ra=05 13 31.55;dec=+01 58 03.7;mag=6.08;" star["HD 38309"] = "ra=05 45 01.80;dec=+04 00 29.5;mag=6.09;" star["HD 41076"] = "ra=06 03 24.77;dec=+11 40 51.9;mag=6.09;" star["W Ori"] = "ra=05 05 23.71;dec=+01 10 39.5;mag=6.10;" star["HD 30870"] = "ra=04 51 43.38;dec=+09 58 30.3;mag=6.11;" star["HD 33419"] = "ra=05 10 03.26;dec=-00 33 54.7;mag=6.11;" star["HD 37232"] = "ra=05 37 19.31;dec=+08 57 06.8;mag=6.11;" star["HD 43683"] = "ra=06 18 05.61;dec=+14 22 58.3;mag=6.12;" star["HD 35317"] = "ra=05 23 51.33;dec=-00 51 59.8;mag=6.13;" star["HD 39632"] = "ra=05 54 13.35;dec=+10 35 11.1;mag=6.13;" star["HD 31764"] = "ra=04 58 59.41;dec=+14 32 35.7;mag=6.14;" star["13 Ori"] = "ra=05 07 38.32;dec=+09 28 21.8;mag=6.15;fd=13;" star["HD 34180"] = "ra=05 15 18.52;dec=-01 24 32.6;mag=6.15;" star["HD 36558"] = "ra=05 32 37.97;dec=+00 00 43.1;mag=6.15;" star["HD 37356"] = "ra=05 37 53.39;dec=-04 48 50.5;mag=6.16;" star["HD 35588"] = "ra=05 25 47.02;dec=+00 31 12.9;mag=6.18;" star["HD 35693"] = "ra=05 27 13.90;dec=+15 15 27.6;mag=6.18;" star["CK Ori"] = "ra=05 30 19.91;dec=+04 12 17.5;mag=6.21;" star["HD 40347"] = "ra=05 58 11.70;dec=-00 59 38.3;mag=6.21;" star["HD 37744"] = "ra=05 40 37.29;dec=-02 49 30.9;mag=6.22;" star["HD 40282"] = "ra=05 57 54.51;dec=+01 13 27.5;mag=6.22;" star["HD 36430"] = "ra=05 31 20.89;dec=-06 42 30.2;mag=6.23;" star["HD 33555"] = "ra=05 10 57.97;dec=-02 15 13.5;mag=6.24;" star["HD 35640"] = "ra=05 26 02.36;dec=-05 31 06.6;mag=6.24;" star["HD 36779"] = "ra=05 34 03.89;dec=-01 02 08.6;mag=6.24;" star["HD 37016"] = "ra=05 35 22.32;dec=-04 25 27.6;mag=6.24;" star["HD 38495"] = "ra=05 46 02.86;dec=-04 16 05.9;mag=6.24;" star["HD 43821"] = "ra=06 18 40.35;dec=+09 02 50.2;mag=6.24;" star["HD 31623"] = "ra=04 57 17.21;dec=-01 04 01.9;mag=6.25;" star["HD 36840"] = "ra=05 34 29.29;dec=-00 00 44.4;mag=6.25;" star["HD 39927"] = "ra=05 55 35.38;dec=-04 47 18.7;mag=6.28;" star["HD 30869"] = "ra=04 51 49.92;dec=+13 39 18.7;mag=6.30;" star["HD 39685"] = "ra=05 54 15.72;dec=+03 13 32.8;mag=6.30;" star["BL Ori"] = "ra=06 25 28.18;dec=+14 43 19.2;mag=6.30;" star["HD 32115"] = "ra=05 00 39.82;dec=-02 03 57.7;mag=6.31;" star["V1197 Ori"] = "ra=05 43 09.32;dec=-01 36 47.4;mag=6.31;" star["HD 43819"] = "ra=06 19 01.85;dec=+17 19 31.0;mag=6.32;" star["Meissa B"] = "ra=05 35 08.50;dec=+09 56 06.0;mag=6.32;fd=39;" star["HD 30321"] = "ra=04 46 24.15;dec=-02 57 15.8;mag=6.33;" star["HD 33946"] = "ra=05 13 47.25;dec=+00 33 37.7;mag=6.33;" star["HD 34648"] = "ra=05 19 35.28;dec=-01 24 42.8;mag=6.33;" star["HD 35407"] = "ra=05 24 36.10;dec=+02 21 11.4;mag=6.33;" star["HD 36285"] = "ra=05 30 20.75;dec=-07 26 05.3;mag=6.33;" star["HD 31739"] = "ra=04 58 10.90;dec=-02 12 46.0;mag=6.34;" star["V1649 Ori"] = "ra=05 23 31.08;dec=+05 19 23.0;mag=6.34;" star["HD 35909"] = "ra=05 28 34.77;dec=+13 40 44.5;mag=6.35;" star["HD 44867"] = "ra=06 24 52.76;dec=+16 03 26.0;mag=6.35;" star["HD 35775"] = "ra=05 27 15.40;dec=+02 20 28.3;mag=6.36;" star["HD 42351"] = "ra=06 11 01.77;dec=+18 07 49.7;mag=6.37;" star["HD 43358"] = "ra=06 15 53.98;dec=+01 10 08.4;mag=6.37;" star["HD 36058"] = "ra=05 28 56.91;dec=-03 18 26.7;mag=6.39;" star["θ2 Ori B"] = "ra=05 35 26.40;dec=-05 25 00.7;mag=6.38;fd=43;" star["HD 43335"] = "ra=06 16 23.79;dec=+17 10 53.9;mag=6.39;" star["HD 34880"] = "ra=05 20 26.41;dec=-05 22 03.1;mag=6.40;" star["V1377 Ori"] = "ra=05 35 35.90;dec=-03 15 10.2;mag=6.40;" star["HD 35656"] = "ra=05 26 38.82;dec=+06 52 07.5;mag=6.41;" star["HD 35912"] = "ra=05 28 01.47;dec=+01 17 53.7;mag=6.41;" star["HD 37904"] = "ra=05 41 40.31;dec=-02 53 47.5;mag=6.41;" star["HD 31423"] = "ra=04 56 09.02;dec=+07 54 17.3;mag=6.42;" star["HD 34317"] = "ra=05 16 41.05;dec=+01 56 50.4;mag=6.42;" star["HD 34878"] = "ra=05 20 43.74;dec=+02 32 41.0;mag=6.43;" star["V1357 Ori"] = "ra=06 13 12.46;dec=+10 37 40.3;mag=6.44;" star["HD 35575"] = "ra=05 25 36.50;dec=-01 29 28.7;mag=6.44;" star["HD 32273"] = "ra=05 02 00.03;dec=+01 36 31.8;mag=6.45;" star["HD 36814"] = "ra=05 34 02.48;dec=-07 01 25.1;mag=6.45;" star["V1389 Ori"] = "ra=06 12 59.57;dec=+06 00 58.6;mag=6.45;" star["HD 37808"] = "ra=05 40 46.19;dec=-10 24 31.2;mag=6.46;" star["V1369 Ori"] = "ra=05 21 19.31;dec=+04 00 43.1;mag=6.49;" star["HD 36150"] = "ra=05 29 41.59;dec=-00 48 08.7;mag=6.49;" star["HD 37635"] = "ra=05 39 30.84;dec=-09 42 23.8;mag=6.49;" star["HD 31411"] = "ra=04 55 58.36;dec=+05 23 56.6;mag=6.50;" star["HD 37150"] = "ra=05 36 15.03;dec=-05 38 52.5;mag=6.51;" star["HD 37808"] = "ra=05 40 46.19;dec=-10 24 31.1;mag=6.52;" star["HD 37017"] = "ra=05 35 21.87;dec=-04 29 39.0;mag=6.56;" star["σ Ori E"] = "ra=05 38 47.19;dec=-02 35 40.5;mag=6.61;fd=48;" star["HD 43317"] = "ra=06 15 47.01;dec=+04 17 01.1;mag=6.62;" star["σ Ori D"] = "ra=05 38 45.62;dec=-02 35 58.9;mag=6.62;fd=48;" star["θ1 Ori D"] = "ra=05 35 17.20;dec=-05 23 15.7;mag=6.71;fd=41;" star["θ1 Ori A"] = "ra=05 35 15.82;dec=-05 23 14.3;mag=6.73;fd=41;" star["HD 35155"] = "ra=05 22 18.64;dec=-08 35 58.0;mag=6.77;" star["Mintaka C"] = "ra=05 32 00.50;dec=-00 17 04.0;mag=6.83;fd=34;" star["HD 42618"] = "ra=06 12 01.0s;dec=+06 46 59″;mag=6.84;" star["KX Ori"] = "ra=05 35 04.79;dec=-04 43 54.6;mag=6.90;" star["Gliese 205"] = "ra=05 31 27.50;dec=-03 40 38.0;mag=6.97;" star["V901 Ori"] = "ra=05 40 56.37;dec=-01 30 25.9;mag=6.97;" edge["Ori"] = "1=Betelgeuse-Alnitak A;2=Alnitak A-Saiph;3=Saiph-Rigel;" edge["Ori"] = edge["Ori"] + "4=Rigel-Mintaka AB;5=Mintaka AB-Bellatrix;" edge["Ori"] = edge["Ori"] + "6=Bellatrix-Betelgeuse;7=Betelgeuse-μ Ori;" edge["Ori"] = edge["Ori"] + "8=μ Ori-ξ Ori;9=ξ Ori-ν Ori;" edge["Ori"] = edge["Ori"] + "10=Bellatrix-ο2 Ori;11=ο2 Ori-π2 Ori;" edge["Ori"] = edge["Ori"] + "12=π2 Ori-π3 Ori;13=π3 Ori-π4 Ori;" edge["Ori"] = edge["Ori"] + "14=π4 Ori-π5 Ori;" radiant = "ra=06 15 00.00;dec=+16 00 00.0;" EndSub Sub Cal_Init ' Calendar | Initialize days of month WQ = Text.GetCharacter(34) CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) iDoM = "1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31;" months = "1=January;2=February;3=March;4=April;5=May;6=June;7=July;" months = months + "8=August;9=September;10=October;11=November;12=December;" symbols = "1=♑;2=♒;3=♓;4=♈;5=♉;6=♊;7=♋;8=♌;9=♍;10=♎;11=♏;12=♐;" EndSub Sub Cal_DrawMonth ' Calendar | Print month ' param iM - month ' param iDoY - days of year ' param iWoY - week of year If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 16 GraphicsWindow.FontName = "Consolas" iW = Math.Remainder((iDoY + iWoY), 7) line = "SUN MON TUE WED THU FRI SAT" + CRLF iWoM = 0 While iWoM < iW line = line + " " iWoM = iWoM + 1 EndWhile For iD = 1 To iDoM[iM] If iD < 10 Then line = line + " " + iD + " " Else line = line + " " + iD + " " EndIf If Math.Remainder(iWoM, 7) = 6 Then line = line + CRLF EndIf iWoM = iWoM + 1 EndFor If Math.Remainder(iWoM, 7) > 0 Then line = line + CRLF EndIf cal = Shapes.AddText(line) Shapes.Move(cal, calendarX, calendarY) EndSub Sub Command_GetArgs ' Command line | Get arguments ' param sBuf - input buffer ' return sArg[] - arguments ' return iN - number of arguments iP = 1 ' buffer pointer iN = 1 ' number of args iC = Text.GetIndexOf(sBuf, ",") ' index of comma While iC > iP sArg[iN] = Text.GetSubText(sBuf, iP, iC - iP) iP = iC + 1 iN = iN + 1 iC = Text.GetIndexOf(sBuf, ",") EndWhile iE = Text.GetLength(sBuf) + 1 ' end of buffer sArg[iN] = Text.GetSubText(sBuf, iP, iE - iP) EndSub Sub Math_CartesianToPolar ' Math | convert cartesian coodinate to polar coordinate ' param x, y - cartesian coordinate ' return r, a - polar coordinate r = Math.SquareRoot(x * x + y * y) If x = 0 And y > 0 Then a = 90 ' [degree] ElseIf x = 0 And y < 0 Then a = -90 ElseIf x = 0 Then a = 0 Else a = Math.ArcTan(y / x) * 180 / Math.Pi EndIf If x < 0 Then a = a + 180 ElseIf x > 0 And y < 0 Then a = a + 360 EndIf EndSub Sub SB_RotateWorkaround ' Small Basic | Rotate workaround for Silverlight ' param shp - current shape ' param x, y - original coordinate ' param alpha - angle [radian] ' returns x, y - workaround coordinate If shp["func"] = "tri" Then x1 = -Math.Floor(shp["x3"] / 2) y1 = -Math.Floor(shp["y3"] / 2) ElseIf shp["func"] = "line" Then x1 = -Math.Floor(Math.Abs(shp["x1"] - shp["x2"]) / 2) y1 = -Math.Floor(Math.Abs(shp["y1"] - shp["y2"]) / 2) EndIf ox = x - x1 oy = y - y1 x = x1 * Math.Cos(alpha) - y1 * Math.Sin(alpha) + ox y = x1 * Math.Sin(alpha) + y1 * Math.Cos(alpha) + oy EndSub Sub SB_Workaround ' Small Basic | Workaround for Silverlight ' returns silverlight - "True" if in remote color = GraphicsWindow.GetPixel(0, 0) If Text.GetLength(color) > 7 Then silverlight = "True" msWait = 300 Else silverlight = "False" EndIf EndSub Sub Shapes_Add ' Shapes | add shapes as shapes data ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - 1 if same scale ' return shWidth, shHeight - total size of shapes ' return shAngle - current angle of shapes Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) Shapes_CalcWidthAndHeight() s = scale For i = iMin To iMax shp = shape[i] GraphicsWindow.PenWidth = shp["pw"] * s If shp["pw"] > 0 Then GraphicsWindow.PenColor = shp["pc"] EndIf If Text.IsSubText("rect|ell|tri|text", shp["func"]) Then GraphicsWindow.BrushColor = shp["bc"] EndIf If shp["func"] = "rect" Then shp["obj"] = Shapes.AddRectangle(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "ell" Then shp["obj"] = Shapes.AddEllipse(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "tri" Then shp["obj"] = Shapes.AddTriangle(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s, shp["x3"] * s, shp["y3"] * s) ElseIf shp["func"] = "line" Then shp["obj"] = Shapes.AddLine(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s) ElseIf shp["func"] = "text" Then If silverlight Then fs = Math.Floor(shp["fs"] * 0.9) Else fs = shp["fs"] EndIf GraphicsWindow.FontSize = fs * s GraphicsWindow.FontName = shp["fn"] shp["obj"] = Shapes.AddText(shp["text"]) EndIf x = shp["x"] y = shp["y"] shp["rx"] = x shp["ry"] = y If silverlight And Text.IsSubText("tri|line", shp["func"]) Then alpha = Math.GetRadians(shp["angle"]) SB_RotateWorkaround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], shX + x * s, shY + y * s) If Text.IsSubText("rect|ell|tri|text", shp["func"]) And (shp["angle"] <> 0) And (shp["angle"] <> "") Then Shapes.Rotate(shp["obj"], shp["angle"]) EndIf shape[i] = shp EndFor shAngle = 0 y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub Sub Shapes_CalcWidthAndHeight ' Shapes | Calculate total width and height of shapes ' param iMin, iMax - shape indices to add ' return shWidth, shHeight - total size of shapes For i = iMin To iMax shp = shape[i] If shp["func"] = "tri" Or shp["func"] = "line" Then xmin = shp["x1"] xmax = shp["x1"] ymin = shp["y1"] ymax = shp["y1"] If shp["x2"] < xmin Then xmin = shp["x2"] EndIf If xmax < shp["x2"] Then xmax = shp["x2"] EndIf If shp["y2"] < ymin Then ymin = shp["y2"] EndIf If ymax < shp["y2"] Then ymax = shp["y2"] EndIf If shp["func"] = "tri" Then If shp["x3"] < xmin Then xmin = shp["x3"] EndIf If xmax < shp["x3"] Then xmax = shp["x3"] EndIf If shp["y3"] < ymin Then ymin = shp["y3"] EndIf If ymax < shp["y3"] Then ymax = shp["y3"] EndIf EndIf shp["width"] = xmax - xmin shp["height"] = ymax - ymin EndIf If i = 1 Then shWidth = shp["x"] + shp["width"] shHeight = shp["y"] + shp["height"] Else If shWidth < shp["x"] + shp["width"] Then shWidth = shp["x"] + shp["width"] EndIf If shHeight < shp["y"] + shp["height"] Then shHeight = shp["y"] + shp["height"] EndIf EndIf shape[i] = shp EndFor EndSub Sub Shapes_Init ' Shapes | Initialize shapes data ' return shX, shY - current position of shapes ' return shape - array of shapes shX = 274 ' x offset shY = 32 ' y offset shape = "" shape[1] = "func=rect;x=94;y=96;width=41;height=46;angle=336;bc=#BC7749;pw=0;" shape[2] = "func=tri;x=125;y=98;x1=7;y1=0;x2=0;y2=18;x3=15;y3=18;angle=326;bc=#BC7749;pw=0;" shape[3] = "func=rect;x=104;y=138;width=21;height=24;angle=351;bc=#BC7749;pw=0;" shape[4] = "func=rect;x=49;y=141;width=29;height=22;angle=19;bc=#BC7749;pw=0;" shape[5] = "func=ell;x=64;y=140;width=32;height=33;bc=#90321D;pw=0;" shape[6] = "func=rect;x=155;y=142;width=29;height=22;angle=313;bc=#BC7749;pw=0;" shape[7] = "func=ell;x=141;y=146;width=32;height=33;bc=#90321D;pw=0;" shape[8] = "func=rect;x=36;y=83;width=15;height=67;angle=350;bc=#BC7749;pw=0;" shape[9] = "func=tri;x=81;y=171;x1=39;y1=0;x2=0;y2=114;x3=78;y3=114;angle=178;bc=#90321D;pw=0;" shape[10] = "func=rect;x=95;y=152;width=44;height=32;angle=7;bc=#BC7749;pw=0;" shape[11] = "func=rect;x=58;y=140;width=14;height=26;angle=21;bc=#90321D;pw=0;" shape[12] = "func=rect;x=159;y=142;width=14;height=26;angle=320;bc=#90321D;pw=0;" shape[13] = "func=rect;x=85;y=144;width=17;height=41;angle=7;bc=#90321D;pw=0;" shape[14] = "func=rect;x=133;y=153;width=14;height=35;angle=8;bc=#90321D;pw=0;" shape[15] = "func=ell;x=40;y=137;width=16;height=21;bc=#BC7749;pw=0;" shape[16] = "func=rect;x=108;y=99;width=17;height=8;bc=#612800;pw=0;" shape[17] = "func=ell;x=115;y=106;width=9;height=9;bc=#000000;pw=0;" shape[18] = "func=rect;x=139;y=237;width=61;height=29;bc=#BC7749;pw=0;" shape[19] = "func=ell;x=184;y=237;width=33;height=31;bc=#BC7749;pw=0;" shape[20] = "func=rect;x=177;y=252;width=23;height=71;angle=27;bc=#BC7749;pw=0;" shape[21] = "func=rect;x=93;y=259;width=33;height=65;angle=4;bc=#BC7749;pw=0;" shape[22] = "func=ell;x=90;y=310;width=33;height=31;bc=#BC7749;pw=0;" shape[23] = "func=rect;x=81;y=325;width=23;height=71;angle=27;bc=#BC7749;pw=0;" shape[24] = "func=rect;x=159;y=316;width=46;height=23;angle=27;bc=#BC7749;pw=0;" shape[25] = "func=ell;x=154;y=311;width=21;height=20;bc=#BC7749;pw=0;" shape[26] = "func=ell;x=195;y=339;width=11;height=11;bc=#BC7749;pw=0;" shape[27] = "func=ell;x=199;y=336;width=14;height=6;angle=29;bc=#BC7749;pw=0;" shape[28] = "func=ell;x=199;y=332;width=14;height=6;angle=29;bc=#BC7749;pw=0;" shape[29] = "func=ell;x=200;y=329;width=14;height=6;angle=29;bc=#BC7749;pw=0;" shape[30] = "func=ell;x=60;y=383;width=21;height=20;bc=#BC7749;pw=0;" shape[31] = "func=rect;x=70;y=390;width=46;height=23;angle=27;bc=#BC7749;pw=0;" shape[32] = "func=line;x=100;y=162;x1=0;y1=0;x2=35;y2=6;pc=#331500;pw=4;" shape[33] = "func=line;x=98;y=170;x1=0;y1=0;x2=37;y2=6;pc=#331500;pw=4;" shape[34] = "func=ell;x=74;y=83;width=51;height=22;angle=337;bc=#612800;pw=0;" shape[35] = "func=ell;x=75;y=95;width=27;height=53;angle=355;bc=#612800;pw=0;" shape[36] = "func=ell;x=119;y=128;width=24;height=11;angle=350;bc=#612800;pw=0;" shape[37] = "func=ell;x=109;y=75;width=11;height=12;bc=#612800;pw=0;" shape[38] = "func=ell;x=113;y=128;width=11;height=12;bc=#612800;pw=0;" shape[39] = "func=ell;x=104;y=127;width=11;height=12;bc=#612800;pw=0;" shape[40] = "func=ell;x=135;y=124;width=11;height=12;bc=#612800;pw=0;" shape[41] = "func=ell;x=97;y=121;width=11;height=12;bc=#612800;pw=0;" shape[42] = "func=ell;x=115;y=85;width=11;height=12;bc=#612800;pw=0;" shape[43] = "func=ell;x=117;y=76;width=11;height=12;bc=#612800;pw=0;" shape[44] = "func=ell;x=98;y=75;width=11;height=12;bc=#612800;pw=0;" shape[45] = "func=ell;x=92;y=78;width=11;height=12;bc=#612800;pw=0;" shape[46] = "func=ell;x=79;y=83;width=11;height=12;bc=#612800;pw=0;" shape[47] = "func=ell;x=72;y=91;width=11;height=12;bc=#612800;pw=0;" shape[48] = "func=ell;x=69;y=102;width=11;height=12;bc=#612800;pw=0;" shape[49] = "func=ell;x=68;y=113;width=11;height=12;bc=#612800;pw=0;" shape[50] = "func=ell;x=70;y=124;width=11;height=12;bc=#612800;pw=0;" shape[51] = "func=ell;x=74;y=134;width=11;height=12;bc=#612800;pw=0;" shape[52] = "func=ell;x=93;y=133;width=11;height=12;bc=#612800;pw=0;" shape[53] = "func=line;x=174;y=316;x1=15;y1=0;x2=0;y2=21;pc=#331500;pw=4;" shape[54] = "func=line;x=182;y=321;x1=15;y1=0;x2=0;y2=22;pc=#331500;pw=4;" shape[55] = "func=line;x=82;y=389;x1=12;y1=0;x2=0;y2=19;pc=#331500;pw=4;" shape[56] = "func=line;x=91;y=393;x1=12;y1=0;x2=0;y2=20;pc=#331500;pw=4;" shape[57] = "func=line;x=176;y=282;x1=0;y1=0;x2=24;y2=11;pc=#331500;pw=4;" shape[58] = "func=line;x=165;y=308;x1=0;y1=0;x2=25;y2=7;pc=#331500;pw=4;" shape[59] = "func=line;x=79;y=358;x1=0;y1=0;x2=24;y2=9;pc=#331500;pw=4;" shape[60] = "func=line;x=68;y=379;x1=0;y1=0;x2=26;y2=6;pc=#331500;pw=4;" shape[61] = "func=line;x=161;y=294;x1=0;y1=14;x2=37;y2=0;pc=#331500;pw=4;" shape[62] = "func=line;x=68;y=368;x1=0;y1=11;x2=33;y2=0;pc=#331500;pw=4;" shape[63] = "func=ell;x=84;y=233;width=23;height=55;angle=6;bc=#AA9988;pw=0;" shape[64] = "func=ell;x=97;y=235;width=62;height=39;angle=341;bc=#AA9988;pw=0;" shape[65] = "func=ell;x=140;y=226;width=54;height=26;angle=359;bc=#AA9988;pw=0;" shape[66] = "func=ell;x=85;y=257;width=37;height=38;angle=354;bc=#AA9988;pw=0;" shape[67] = "func=ell;x=135;y=249;width=48;height=23;angle=341;bc=#AA9988;pw=0;" shape[68] = "func=ell;x=113;y=252;width=37;height=38;angle=354;bc=#AA9988;pw=0;" shape[69] = "func=ell;x=97;y=243;width=2;height=0;bc=#FFFFFF;pw=0;" shape[70] = "func=ell;x=103;y=234;width=17;height=18;bc=#FFFFFF;pc=#AA8327;pw=4;" shape[71] = "func=ell;x=116;y=231;width=17;height=18;bc=#FFFFFF;pc=#AA8327;pw=4;" shape[72] = "func=ell;x=129;y=228;width=17;height=18;bc=#FFFFFF;pc=#AA8327;pw=4;" shape[73] = "func=rect;x=107;y=232;width=10;height=12;bc=#FFFFFF;pw=0;" shape[74] = "func=rect;x=119;y=232;width=10;height=12;angle=348;bc=#FFFFFF;pw=0;" shape[75] = "func=rect;x=131;y=227;width=10;height=12;angle=337;bc=#FFFFFF;pw=0;" shape[76] = "func=ell;x=97;y=232;width=10;height=19;bc=#FFFFFF;pc=#AA8327;pw=4;" shape[77] = "func=ell;x=141;y=221;width=10;height=19;angle=335;bc=#FFFFFF;pc=#AA8327;pw=4;" shape[78] = "func=rect;x=101;y=231;width=3;height=12;angle=5;bc=#FFFFFF;pw=0;" shape[79] = "func=rect;x=143;y=222;width=3;height=12;angle=335;bc=#FFFFFF;pw=0;" shape[80] = "func=tri;x=55;y=271;x1=8;y1=0;x2=0;y2=23;x3=16;y3=23;angle=245;bc=#2E2E2E;pw=0;" shape[81] = "func=rect;x=70;y=260;width=49;height=16;angle=336;bc=#2E2E2E;pw=0;" shape[82] = "func=rect;x=116;y=243;width=36;height=14;angle=334;bc=#90321D;pw=0;" shape[83] = "func=rect;x=116;y=237;width=6;height=41;angle=333;bc=#666666;pw=0;" shape[84] = "func=ell;x=106;y=229;width=13;height=15;bc=#666666;pw=0;" shape[85] = "func=ell;x=118;y=270;width=13;height=15;bc=#666666;pw=0;" shape[86] = "func=line;x=123;y=246;x1=0;y1=0;x2=6;y2=13;pw=0;" shape[87] = "func=line;x=123;y=246;x1=0;y1=0;x2=6;y2=14;pc=#331500;pw=4;" shape[88] = "func=line;x=129;y=244;x1=0;y1=0;x2=6;y2=12;pc=#331500;pw=4;" shape[89] = "func=line;x=134;y=241;x1=0;y1=0;x2=6;y2=12;pc=#331500;pw=4;" shape[90] = "func=line;x=142;y=238;x1=0;y1=0;x2=4;y2=13;pc=#331500;pw=4;" shape[91] = "func=ell;x=21;y=58;width=33;height=29;angle=323;bc=#BC7749;pw=0;" shape[92] = "func=rect;x=3;y=45;width=129;height=14;angle=329;bc=#984106;pw=0;" shape[93] = "func=ell;x=0;y=79;width=17;height=16;bc=#984106;pw=0;" shape[94] = "func=ell;x=75;y=8;width=80;height=31;angle=332;bc=#984106;pw=0;" shape[95] = "func=ell;x=135;y=58;width=2;height=2;bc=#984106;pw=0;" shape[96] = "func=ell;x=59;y=36;width=28;height=11;angle=328;bc=#984106;pw=0;" shape[97] = "func=ell;x=75;y=42;width=28;height=11;angle=334;bc=#984106;pw=0;" shape[98] = "func=ell;x=108;y=0;width=28;height=11;angle=344;bc=#984106;pw=0;" shape[99] = "func=ell;x=125;y=13;width=25;height=15;angle=321;bc=#984106;pw=0;" shape[100] = "func=ell;x=43;y=64;width=11;height=10;bc=#BC7749;pw=0;" shape[101] = "func=ell;x=37;y=48;width=9;height=16;angle=343;bc=#BC7749;pw=0;" shape[102] = "func=ell;x=31;y=52;width=9;height=16;angle=343;bc=#BC7749;pw=0;" shape[103] = "func=ell;x=26;y=57;width=9;height=16;angle=343;bc=#BC7749;pw=0;" shape[104] = "func=ell;x=21;y=63;width=9;height=16;angle=343;bc=#BC7749;pw=0;" shape[105] = "func=ell;x=226;y=64;width=29;height=96;angle=346;bc=#AB7630;pw=0;" shape[106] = "func=ell;x=224;y=109;width=29;height=96;angle=346;bc=#AB7630;pw=0;" shape[107] = "func=ell;x=210;y=130;width=29;height=96;angle=346;bc=#AB7630;pw=0;" shape[108] = "func=ell;x=187;y=110;width=29;height=96;angle=346;bc=#AB7630;pw=0;" shape[109] = "func=ell;x=170;y=125;width=18;height=49;bc=#4F3112;pw=0;" shape[110] = "func=ell;x=178;y=104;width=18;height=49;bc=#4F3112;pw=0;" shape[111] = "func=ell;x=190;y=90;width=18;height=49;bc=#4F3112;pw=0;" shape[112] = "func=ell;x=202;y=83;width=18;height=49;bc=#4F3112;pw=0;" shape[113] = "func=ell;x=213;y=66;width=18;height=49;bc=#4F3112;pw=0;" shape[114] = "func=ell;x=224;y=57;width=18;height=49;bc=#4F3112;pw=0;" shape[115] = "func=ell;x=218;y=90;width=18;height=49;bc=#4F3112;pw=0;" shape[116] = "func=ell;x=209;y=111;width=18;height=49;bc=#4F3112;pw=0;" shape[117] = "func=ell;x=196;y=120;width=18;height=49;bc=#4F3112;pw=0;" shape[118] = "func=ell;x=183;y=128;width=18;height=49;bc=#4F3112;pw=0;" shape[119] = "func=ell;x=223;y=245;width=18;height=49;bc=#4F3112;pw=0;" shape[120] = "func=rect;x=228;y=186;width=8;height=63;bc=#AB7630;pw=0;" shape[121] = "func=tri;x=224;y=133;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[122] = "func=tri;x=215;y=147;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[123] = "func=tri;x=220;y=140;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[124] = "func=tri;x=206;y=153;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[125] = "func=tri;x=199;y=162;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[126] = "func=tri;x=189;y=168;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[127] = "func=tri;x=175;y=165;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[128] = "func=tri;x=232;y=273;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[129] = "func=tri;x=223;y=277;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" shape[130] = "func=tri;x=228;y=284;x1=4;y1=0;x2=0;y2=25;x3=9;y3=25;angle=181;bc=#4F3112;pw=0;" EndSub Sub Shapes_Move ' Shapes | Move shapes ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - to zoom ' param x, y - position to move ' return shX, shY - new position of shapes Stack.PushValue("local", i) s = scale shX = x shY = y For i = iMin To iMax shp = shape[i] If silverlight And Text.IsSubText("tri|line", shp["func"]) Then _x = shp["wx"] _y = shp["wy"] Else _x = shp["rx"] _y = shp["ry"] EndIf Shapes.Move(shp["obj"], shX + _x * s, shY + _y * s) EndFor i = Stack.PopValue("local") EndSub End>QMS609-0.sb< Start>QMS609.sb< ' Orionid ' Version 0.1 ' オリオン座流星群 ' Copyright © 2016 Nonki Takahshi. The MIT License. ' Program ID ' ' Reference: ' http://en.wikipedia.org/wiki/List_of_stars_in_Orion title = "Orionid" r = 520 ' [px] delay = 100 ' [ms] Init() Cal_Init() InitStars() ra = radiant["ra"] dec = radiant["dec"] Mapping() rot = ra tilt = dec GraphicsWindow.Title = title + " RA=" + rot + "h Dec=" + tilt + "°" DrawRA() DrawDec() DrawEcliptic() DrawStars() DrawCalendar() DrawMeteorShower() While "True" If keyDown Then If key = "Right" Then rot = rot + 0.25 If 24 <= rot Then rot = rot - 24 EndIf ElseIf key = "Left" Then rot = rot - 0.25 If rot < 0 Then rot = rot + 24 EndIf ElseIf key = "Up" Then If tilt <= 85 Then tilt = tilt + 5 EndIf ElseIf key = "Down" Then If -85 <= tilt Then tilt = tilt - 5 EndIf ElseIf key = "Add" Then r = r * 1.2 ElseIf key = "Subtract" Then r = r / 1.2 EndIf GraphicsWindow.Title = title + " RA=" + rot + "h Dec=" + tilt + "°" GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillRectangle(0, 0, gw, gh) DrawRA() DrawDec() DrawEcliptic() DrawStars() keyDown = "False" EndIf Program.Delay(delay) EndWhile Sub Init gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "Black" ox = gw / 2 oy = gh * 0.35 rot = 0 ' rotation tilt = 0 monthX = 40 monthY = 20 calendarX = 40 calendarY = gh - 180 year = 2016 month = 10 GraphicsWindow.KeyDown = OnKeyDown EndSub Sub OnKeyDown keyDown = "True" key = GraphicsWindow.LastKey EndSub Sub DrawRA GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#666666" roll = 0 For ra = 0 To 23 For dec = -90 To 90 Step 5 Mapping() If -90 < dec Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndFor EndSub Sub DrawDec GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#666666" roll = 0 For dec = -80 To 80 Step 10 For ra = 0 To 24 Step 0.2 Mapping() If 0 < ra Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndFor EndSub Sub DrawEcliptic GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "#999900" roll = 23.26 dec = 0 For ra = 0 To 24 Step 0.2 Mapping() If 0 < ra Then DrawLine() EndIf xLast = x yLast = y zLast = z EndFor EndSub Sub DrawLine visible = "False" If 0 <= z And 0 <= zLast Then If 0 <= x And x < gw And 0 <= y And y < gh Then visible = "True" ElseIf 0 <= xLast And xLast < gw And 0 <= yLast And yLast < gh Then visible = "True" EndIf EndIf If visible Then GraphicsWindow.DrawLine(xLast, yLast, x, y) EndIf EndSub Sub DrawStars GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "White" n = Array.GetItemCount(star) index = Array.GetAllIndices(star) roll = 0 For i = 1 To n ra = star[index[i]]["ra"] dec = star[index[i]]["dec"] Mapping() If ell[index[i]] <> "" Then Shapes.Remove(ell[index[i]]) ell[index[i]] = "" EndIf If 0 <= z Then mag = star[index[i]]["mag"] d = 16 / (mag + 3) ell[index[i]] = Shapes.AddEllipse(d, d) Shapes.Move(ell[index[i]], x - d / 2, y - d / 2) EndIf EndFor GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "LightGray" nSign = Array.GetItemCount(edge) iSign = Array.GetAllIndices(edge) For j = 1 To nSign n = Array.GetItemCount(edge[iSign[j]]) index = Array.GetAllIndices(edge[iSign[j]]) For i = 1 To n e = edge[iSign[j]][index[i]] m = Text.GetIndexOf(e, "-") ra = star[Text.GetSubText(e, 1, m - 1)]["RA"] dec = star[Text.GetSubText(e, 1, m - 1)]["Dec"] Mapping() x1 = x y1 = y z1 = z ra = star[Text.GetSubTextToEnd(e, m + 1)]["RA"] dec = star[Text.GetSubTextToEnd(e, m + 1)]["Dec"] Mapping() x2 = x y2 = y z2 = z If connect[iSign[j]][index[i]] <> "" Then Shapes.Remove(connect[iSign[j]][index[i]]) connect[iSign[j]][index[i]] = "" EndIf visible = "False" If 0 <= z1 And 0 <= z2 Then If 0 <= x1 And x1 <= gw And 0 <= y1 And y1 <= gh Then visible = "True" ElseIf 0 <= x2 And x2 <= gw And 0 <= y2 And y2 <= gh Then visible = "True" EndIf If visible Then connect[iSign[j]][index[i]] = Shapes.AddLine(x1, y1, x2, y2) EndIf EndIf EndFor ' i EndFor ' j EndSub Sub DrawMeteorShower ra = radiant["RA"] dec = radiant["Dec"] Mapping() rx = x ry = y GraphicsWindow.PenColor = "White" While "True" Program.Delay(2000) angle = Math.GetRandomNumber(360) _a = Math.GetRadians(angle) r1 = Math.GetRandomNumber(100) + 50 r2 = r1 * 2.5 x1 = rx + r1 * Math.Sin(_a) y1 = ry - r1 * Math.Cos(_a) x2 = rx + r2 * Math.Sin(_a) y2 = ry - r2 * Math.Cos(_a) meteor = Shapes.AddLine(x1, y1, x2, y2) For op = 100 To 0 Step -5 Shapes.SetOpacity(meteor, op) Program.Delay(50) EndFor Shapes.Remove(meteor) EndWhile EndSub Sub DrawCalendar GraphicsWindow.BrushColor = "White" If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 30 txt = Shapes.AddText(months[month]) Shapes.Move(txt, monthX, monthY) If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 40 txt = Shapes.AddText(year) Shapes.Move(txt, monthX, monthY + 30) sBuf = year + "," + month Command_GetArgs() iYear = sArg[1] if iYear = "" Then Goto lEnd Endif If Math.Remainder(iYear, 4) = 0 And Math.Remainder(iYear, 100) > 0 Or Math.Remainder(iYear, 400) = 0 Then iDoM[2] = iDoM[2] + 1 Endif iNoL = Math.Floor((iYear - 1) / 4) - Math.Floor((iYear - 1) / 100) + Math.Floor((iYear - 1) / 400) ' number of leap year iWoY = Math.Remainder((iYear + iNoL), 7) ' week of year iMonth = sArg[2] If iMonth = "" Then iM0 = 1 iM1 = 12 Else iM0 = iMonth iM1 = iMonth Endif iDoY = 0 ' days of year iNoM = 1 ' number of month For iM = iM0 To iM1 While iNoM < iM iDoY = iDoY + iDoM[iNoM] iNoM = iNoM + 1 EndWhile Cal_DrawMonth() EndFor lEnd: EndSub Sub Mapping ' param ra - right asension [h] ' param rot - rotation [h] ' param dec - declination [deg] ' param tilt - tilt [deg] ' param roll - roll [deg] ' param r - radius [px] ' return x, y - position in the graphics window [px] ' return z - visible if 0 <= z If Text.IsSubText(ra, " ") Then _ra = Text.GetSubText(ra, 1, 2) _ra = _ra + Text.GetSubText(ra, 4, 2) / 60 _ra = _ra + Text.GetSubText(ra, 7, 5) / 3600 ra = _ra EndIf If Text.IsSubText(dec, " ") Then _dec = Text.GetSubText(dec, 2, 2) _dec = _dec + Text.GetSubText(dec, 5, 2) / 60 _dec = _dec + Text.GetSubText(dec, 8, 5) / 3600 _dec = _dec * Text.Append(Text.GetSubText(dec, 1, 1), "1") dec = _dec EndIf φ = Math.GetRadians(ra * 15) θ = Math.GetRadians(dec) x = ox - r * Math.Sin(φ) * Math.Cos(θ) y = oy - r * Math.Sin(θ) z = r * Math.Cos(φ) * Math.Cos(θ) If roll <> 0 Then _x = x - ox _y = y - oy ψ = Math.GetRadians(roll) x = ox + Math.Cos(ψ) * _x - Math.Sin(ψ) * _y y = oy + Math.Sin(ψ) * _x + Math.Cos(ψ) * _y EndIf If rot <> 0 Then _x = x - ox _z = z ρ = Math.GetRadians(-rot * 15) x = ox + Math.Cos(ρ) * _x - Math.Sin(ρ) * _z z = Math.Sin(ρ) * _x + Math.Cos(ρ) * _z EndIf If tilt <> 0 Then _z = z _y = y - oy τ = Math.GetRadians(tilt) z = Math.Cos(τ) * _z - Math.Sin(τ) * _y y = oy + Math.Sin(τ) * _z + Math.Cos(τ) * _y EndIf EndSub Sub InitStars ' Initialize stars in Orion ' index: Flamsteed designation ' RA (Right ascension), Dec (Declination), Mag (Apparent magnitude) star["Rigel"] = "ra=05 14 32.27;dec=-08 12 05.9;mag=0.18;fd=19;" star["Betelgeuse"] = "ra=05 55 10.29;dec=+07 24 25.3;mag=0.42;fd=58;" star["Bellatrix"] = "ra=05 25 07.87;dec=+06 20 59.0;mag=1.64;fd=24;" star["Alnilam"] = "ra=05 36 12.81;dec=-01 12 06.9;mag=1.69;fd=46;" star["Alnitak A"] = "ra=05 40 45.52;dec=-01 56 33.3;mag=1.88;fd=50;" star["Saiph"] = "ra=05 47 45.39;dec=-09 40 10.6;mag=2.07;fd=53;" star["Mintaka AB"] = "ra=05 32 00.40;dec=-00 17 56.7;mag=2.20;fd=34;" star["ι Ori"] = "ra=05 35 25.98;dec=-05 54 35.6;mag=2.75;fd=44;" star["π3 Ori"] = "ra=04 49 50.14;dec=+06 57 40.5;mag=3.19;fd=1;" star["η Ori"] = "ra=05 24 28.62;dec=-02 23 49.7;mag=3.35;fd=28;" star["Meissa A"] = "ra=05 35 08.28;dec=+09 56 03.0;mag=3.47;fd=39;" star["τ Ori"] = "ra=05 17 36.40;dec=-06 50 39.8;mag=3.59;fd=20;" star["π4 Ori"] = "ra=04 51 12.37;dec=+05 36 18.4;mag=3.68;fd=3;" star["Alnitak BC"] = "ra=05 40 45.60;dec=-01 56 34.0;mag=3.70;fd=50;" star["π5 Ori"] = "ra=04 54 15.10;dec=+02 26 26.4;mag=3.71;fd=8;" star["σ Ori AB"] = "ra=05 38 44.77;dec=-02 36 00.2;mag=3.77;fd=48;" star["ο2 Ori"] = "ra=04 56 22.32;dec=+13 30 52.5;mag=4.06;fd=9;" star["φ2 Ori"] = "ra=05 36 54.33;dec=+09 17 29.1;mag=4.09;fd=40;" star["μ Ori"] = "ra=06 02 22.99;dec=+09 38 50.5;mag=4.12;fd=61;" star["29 Ori"] = "ra=05 23 56.84;dec=-07 48 28.6;mag=4.13;fd=29;" star["32 Ori"] = "ra=05 30 47.05;dec=+05 56 53.6;mag=4.20;fd=32;" star["π2 Ori"] = "ra=04 50 36.72;dec=+08 54 00.9;mag=4.35;fd=2;" star["φ1 Ori"] = "ra=05 34 49.24;dec=+09 29 22.5;mag=4.39;fd=37;" star["χ1 Ori"] = "ra=05 54 23.08;dec=+20 16 35.1;mag=4.39;fd=54;" star["ν Ori"] = "ra=06 07 34.32;dec=+14 46 06.7;mag=4.42;fd=67;" star["ξ Ori"] = "ra=06 11 56.40;dec=+14 12 31.7;mag=4.45;fd=70;" star["ρ Ori"] = "ra=05 13 17.48;dec=+02 51 40.5;mag=4.46;fd=17;" star["π6 Ori"] = "ra=04 58 32.90;dec=+01 42 50.5;mag=4.47;fd=10;" star["ω Ori"] = "ra=05 39 11.15;dec=+04 07 17.3;mag=4.50;fd=47;" star["HD 40657"] = "ra=06 00 03.35;dec=-03 04 26.7;mag=4.53;" star["42 Ori"] = "ra=05 35 23.16;dec=-04 50 18.0;mag=4.58;fd=42;" star["ψ2 Ori"] = "ra=05 26 50.23;dec=+03 05 44.4;mag=4.59;fd=30;" star["υ Ori"] = "ra=05 31 55.86;dec=-07 18 05.5;mag=4.62;fd=36;" star["π1 Ori"] = "ra=04 54 53.70;dec=+10 09 04.1;mag=4.64;fd=7;" star["χ2 Ori"] = "ra=06 03 55.18;dec=+20 08 18.5;mag=4.64;fd=62;" star["11 Ori"] = "ra=05 04 34.14;dec=+15 24 15.1;mag=4.65;fd=11;" star["ο1 Ori"] = "ra=04 52 31.96;dec=+14 15 02.8;mag=4.71;fd=4;" star["31 Ori"] = "ra=05 29 43.98;dec=-01 05 31.8;mag=4.71;fd=31;" star["22 Ori"] = "ra=05 21 45.75;dec=-00 22 56.9;mag=4.72;fd=22;" star["56 Ori"] = "ra=05 52 26.44;dec=+01 51 18.6;mag=4.76;fd=56;" star["49 Ori"] = "ra=05 38 53.09;dec=-07 12 45.8;mag=4.77;fd=49;" star["HD 36960"] = "ra=05 35 02.68;dec=-06 00 07.3;mag=4.78;" star["15 Ori"] = "ra=05 09 41.96;dec=+15 35 50.2;mag=4.81;" star["ψ1 Ori"] = "ra=05 24 44.83;dec=+01 50 47.2;mag=4.89;fd=25;" star["51 Ori"] = "ra=05 42 28.66;dec=+01 28 28.8;mag=4.90;fd=51;" star["HD 44131"] = "ra=06 19 59.60;dec=-02 56 40.2;mag=4.91;" star["HD 37756"] = "ra=05 40 50.72;dec=-01 07 43.6;mag=4.95;" star["69 Ori"] = "ra=06 12 03.28;dec=+16 07 49.6;mag=4.95;fd=69;" star["θ2 Ori A"] = "ra=05 35 22.90;dec=-05 24 57.8;mag=4.98;fd=43;" star["23 Ori"] = "ra=05 22 50.00;dec=+03 32 40.0;mag=5.00;fd=23;" star["74 Ori"] = "ra=06 16 26.57;dec=+12 16 18.2;mag=5.04;fd=74;" star["27 Ori"] = "ra=05 24 28.91;dec=-00 53 30.0;mag=5.07;fd=27;" star["θ1 Ori C"] = "ra=05 35 16.47;dec=-05 23 22.9;mag=5.13;fd=41;" star["64 Ori"] = "ra=06 03 27.36;dec=+19 41 26.2;mag=5.14;fd=64;" star["6 Ori"] = "ra=04 54 46.91;dec=+11 25 33.5;mag=5.18;fd=6;" star["HD 33554"] = "ra=05 11 41.56;dec=+16 02 44.4;mag=5.18;" star["71 Ori"] = "ra=06 14 50.94;dec=+19 09 24.8;mag=5.20;fd=71;" star["60 Ori"] = "ra=05 58 49.58;dec=+00 33 10.7;mag=5.21;fd=60;" star["45 Ori"] = "ra=05 35 39.49;dec=-04 51 21.9;mag=5.24;fd=45;" star["52 Ori"] = "ra=05 48 00.23;dec=+06 27 15.2;mag=5.26;fd=52;" star["38 Ori"] = "ra=05 34 16.79;dec=+03 46 01.0;mag=5.32;fd=38;" star["5 Ori"] = "ra=04 53 22.76;dec=+02 30 29.8;mag=5.33;fd=5;" star["HD 31296"] = "ra=04 54 47.79;dec=+07 46 45.0;mag=5.33;" star["14 Ori"] = "ra=05 07 52.87;dec=+08 29 54.9;mag=5.33;fd=14;" star["21 Ori"] = "ra=05 19 11.23;dec=+02 35 45.4;mag=5.34;fd=21;" star["HD 36591"] = "ra=05 32 41.35;dec=-01 35 30.6;mag=5.34;" star["72 Ori"] = "ra=06 15 25.13;dec=+16 08 35.5;mag=5.34;fd=72;" star["HD 30210"] = "ra=04 46 01.70;dec=+11 42 20.2;mag=5.35;" star["VV Ori"] = "ra=05 33 31.45;dec=-01 09 21.9;mag=5.36;" star["55 Ori"] = "ra=05 51 21.98;dec=-07 31 04.8;mag=5.36;fd=55;" star["HD 30034"] = "ra=04 44 25.77;dec=+11 08 46.2;mag=5.39;" star["75 Ori"] = "ra=06 17 06.62;dec=+09 56 33.1;mag=5.39;fd=75;" star["U Ori"] = "ra=05 55 49.30;dec=+20 10 30.0;mag=5.40;" star["16 Ori"] = "ra=05 09 19.60;dec=+09 49 46.6;mag=5.43;fd=16;" star["73 Ori"] = "ra=06 15 44.97;dec=+12 33 03.9;mag=5.44;fd=73;" star["33 Ori"] = "ra=05 31 14.53;dec=+03 17 31.7;mag=5.46;fd=33;" star["HD 34043"] = "ra=05 14 44.05;dec=+05 09 22.1;mag=5.50;" star["18 Ori"] = "ra=05 16 04.14;dec=+11 20 28.9;mag=5.52;fd=18;" star["HD 35536"] = "ra=05 25 01.74;dec=-10 19 43.8;mag=5.60;" star["35 Ori"] = "ra=05 33 54.29;dec=+14 18 20.1;mag=5.60;fd=35;" star["HD 36881"] = "ra=05 35 13.24;dec=+10 14 24.4;mag=5.60;" star["HD 43318"] = "ra=06 15 34.36;dec=-00 30 42.0;mag=5.62;" star["66 Ori"] = "ra=06 04 58.36;dec=+04 09 31.2;mag=5.63;fd=66;" star["HD 36959"] = "ra=05 35 01.01;dec=-06 00 33.4;mag=5.67;" star["63 Ori"] = "ra=06 04 58.19;dec=+05 25 11.9;mag=5.67;fd=63;" star["HD 44033"] = "ra=06 20 04.23;dec=+14 39 04.2;mag=5.67;" star["HD 35007"] = "ra=05 21 31.84;dec=-00 24 59.4;mag=5.68;" star["HD 35299"] = "ra=05 23 42.31;dec=-00 09 35.3;mag=5.69;" star["HD 40369"] = "ra=05 58 53.24;dec=+12 48 29.7;mag=5.70;" star["HD 42111"] = "ra=06 08 57.90;dec=+02 29 59.0;mag=5.70;" star["HD 43587"] = "ra=06 17 16.25;dec=+05 05 58.9;mag=5.70;" star["HD 37209"] = "ra=05 36 35.69;dec=-06 03 53.1;mag=5.71;" star["68 Ori"] = "ra=06 12 01.34;dec=+19 47 26.1;mag=5.76;fd=68;" star["HD 36166"] = "ra=05 29 54.77;dec=+01 47 21.3;mag=5.77;" star["HD 34989"] = "ra=05 21 43.56;dec=+08 25 42.8;mag=5.78;" star["HD 38527"] = "ra=05 46 52.15;dec=+09 31 21.0;mag=5.78;" star["HD 31373"] = "ra=04 55 50.16;dec=+15 02 25.1;mag=5.79;" star["HD 39007"] = "ra=05 50 02.68;dec=+09 52 16.4;mag=5.79;" star["HD 36134"] = "ra=05 29 23.70;dec=-03 26 46.9;mag=5.80;" star["HD 43023"] = "ra=06 13 54.24;dec=-03 44 29.1;mag=5.83;" star["HD 42954"] = "ra=06 14 28.58;dec=+17 54 23.0;mag=5.86;" star["HD 37320"] = "ra=05 38 01.11;dec=+07 32 29.2;mag=5.87;" star["HD 39910"] = "ra=05 55 30.16;dec=-04 36 59.4;mag=5.87;" star["HD 33646"] = "ra=05 11 45.35;dec=+01 02 13.4;mag=5.88;" star["HD 33608"] = "ra=05 11 19.13;dec=-02 29 26.8;mag=5.89;" star["HD 40020"] = "ra=05 56 49.39;dec=+11 31 16.3;mag=5.89;" star["59 Ori"] = "ra=05 58 24.44;dec=+01 50 13.7;mag=5.89;fd=59;" star["HD 33833"] = "ra=05 12 48.12;dec=-06 03 25.6;mag=5.90;" star["HD 32263"] = "ra=05 01 50.35;dec=+00 43 19.8;mag=5.91;" star["HD 43112"] = "ra=06 15 08.46;dec=+13 51 03.9;mag=5.91;" star["HD 36780"] = "ra=05 34 04.06;dec=-01 28 12.7;mag=5.92;" star["57 Ori"] = "ra=05 54 56.69;dec=+19 44 58.6;mag=5.92;fd=57;" star["HD 36162"] = "ra=05 30 26.17;dec=+15 21 38.0;mag=5.93;" star["HD 37788"] = "ra=05 41 05.59;dec=+00 20 15.7;mag=5.93;" star["HD 38529"] = "ra=05 46 34.96;dec=+01 10 06.7;mag=5.94;" star["HD 39421"] = "ra=05 52 07.73;dec=-09 02 31.1;mag=5.95;" star["HD 37481"] = "ra=05 38 37.97;dec=-06 34 26.2;mag=5.96;" star["HD 39051"] = "ra=05 50 13.06;dec=+04 25 24.6;mag=5.96;" star["HD 39286"] = "ra=05 52 23.41;dec=+19 52 04.3;mag=5.96;" star["HD 37171"] = "ra=05 37 04.35;dec=+11 02 06.2;mag=5.97;" star["HD 38089"] = "ra=05 42 53.91;dec=-06 47 46.7;mag=5.97;" star["HD 38858"] = "ra=05 48 34.90;dec=-04 05 38.7;mag=5.97;" star["HD 39118"] = "ra=05 50 30.03;dec=+02 01 29.0;mag=5.97;" star["HD 39885"] = "ra=05 56 28.04;dec=+09 30 33.9;mag=5.97;" star["HD 31331"] = "ra=04 54 50.71;dec=+00 28 01.8;mag=5.98;" star["HD 35281"] = "ra=05 23 18.51;dec=-08 24 56.1;mag=5.99;" star["HD 37594"] = "ra=05 39 31.15;dec=-03 33 53.0;mag=5.99;" star["HD 39775"] = "ra=05 54 44.04;dec=+00 58 07.0;mag=5.99;" star["HD 44497"] = "ra=06 22 36.42;dec=+12 34 13.1;mag=6.00;" star["HD 37303"] = "ra=05 37 27.36;dec=-05 56 18.2;mag=6.03;" star["HD 30545"] = "ra=04 48 44.63;dec=+03 35 18.8;mag=6.04;" star["HD 32686"] = "ra=05 04 54.53;dec=-03 02 22.8;mag=6.04;" star["V1031 Ori"] = "ra=05 47 26.90;dec=-10 31 58.5;mag=6.04;" star["HD 42477"] = "ra=06 11 27.91;dec=+13 38 19.0;mag=6.04;" star["HD 43285"] = "ra=06 15 40.18;dec=+06 03 58.3;mag=6.07;" star["HD 33883"] = "ra=05 13 31.55;dec=+01 58 03.7;mag=6.08;" star["HD 38309"] = "ra=05 45 01.80;dec=+04 00 29.5;mag=6.09;" star["HD 41076"] = "ra=06 03 24.77;dec=+11 40 51.9;mag=6.09;" star["W Ori"] = "ra=05 05 23.71;dec=+01 10 39.5;mag=6.10;" star["HD 30870"] = "ra=04 51 43.38;dec=+09 58 30.3;mag=6.11;" star["HD 33419"] = "ra=05 10 03.26;dec=-00 33 54.7;mag=6.11;" star["HD 37232"] = "ra=05 37 19.31;dec=+08 57 06.8;mag=6.11;" star["HD 43683"] = "ra=06 18 05.61;dec=+14 22 58.3;mag=6.12;" star["HD 35317"] = "ra=05 23 51.33;dec=-00 51 59.8;mag=6.13;" star["HD 39632"] = "ra=05 54 13.35;dec=+10 35 11.1;mag=6.13;" star["HD 31764"] = "ra=04 58 59.41;dec=+14 32 35.7;mag=6.14;" star["13 Ori"] = "ra=05 07 38.32;dec=+09 28 21.8;mag=6.15;fd=13;" star["HD 34180"] = "ra=05 15 18.52;dec=-01 24 32.6;mag=6.15;" star["HD 36558"] = "ra=05 32 37.97;dec=+00 00 43.1;mag=6.15;" star["HD 37356"] = "ra=05 37 53.39;dec=-04 48 50.5;mag=6.16;" star["HD 35588"] = "ra=05 25 47.02;dec=+00 31 12.9;mag=6.18;" star["HD 35693"] = "ra=05 27 13.90;dec=+15 15 27.6;mag=6.18;" star["CK Ori"] = "ra=05 30 19.91;dec=+04 12 17.5;mag=6.21;" star["HD 40347"] = "ra=05 58 11.70;dec=-00 59 38.3;mag=6.21;" star["HD 37744"] = "ra=05 40 37.29;dec=-02 49 30.9;mag=6.22;" star["HD 40282"] = "ra=05 57 54.51;dec=+01 13 27.5;mag=6.22;" star["HD 36430"] = "ra=05 31 20.89;dec=-06 42 30.2;mag=6.23;" star["HD 33555"] = "ra=05 10 57.97;dec=-02 15 13.5;mag=6.24;" star["HD 35640"] = "ra=05 26 02.36;dec=-05 31 06.6;mag=6.24;" star["HD 36779"] = "ra=05 34 03.89;dec=-01 02 08.6;mag=6.24;" star["HD 37016"] = "ra=05 35 22.32;dec=-04 25 27.6;mag=6.24;" star["HD 38495"] = "ra=05 46 02.86;dec=-04 16 05.9;mag=6.24;" star["HD 43821"] = "ra=06 18 40.35;dec=+09 02 50.2;mag=6.24;" star["HD 31623"] = "ra=04 57 17.21;dec=-01 04 01.9;mag=6.25;" star["HD 36840"] = "ra=05 34 29.29;dec=-00 00 44.4;mag=6.25;" star["HD 39927"] = "ra=05 55 35.38;dec=-04 47 18.7;mag=6.28;" star["HD 30869"] = "ra=04 51 49.92;dec=+13 39 18.7;mag=6.30;" star["HD 39685"] = "ra=05 54 15.72;dec=+03 13 32.8;mag=6.30;" star["BL Ori"] = "ra=06 25 28.18;dec=+14 43 19.2;mag=6.30;" star["HD 32115"] = "ra=05 00 39.82;dec=-02 03 57.7;mag=6.31;" star["V1197 Ori"] = "ra=05 43 09.32;dec=-01 36 47.4;mag=6.31;" star["HD 43819"] = "ra=06 19 01.85;dec=+17 19 31.0;mag=6.32;" star["Meissa B"] = "ra=05 35 08.50;dec=+09 56 06.0;mag=6.32;fd=39;" star["HD 30321"] = "ra=04 46 24.15;dec=-02 57 15.8;mag=6.33;" star["HD 33946"] = "ra=05 13 47.25;dec=+00 33 37.7;mag=6.33;" star["HD 34648"] = "ra=05 19 35.28;dec=-01 24 42.8;mag=6.33;" star["HD 35407"] = "ra=05 24 36.10;dec=+02 21 11.4;mag=6.33;" star["HD 36285"] = "ra=05 30 20.75;dec=-07 26 05.3;mag=6.33;" star["HD 31739"] = "ra=04 58 10.90;dec=-02 12 46.0;mag=6.34;" star["V1649 Ori"] = "ra=05 23 31.08;dec=+05 19 23.0;mag=6.34;" star["HD 35909"] = "ra=05 28 34.77;dec=+13 40 44.5;mag=6.35;" star["HD 44867"] = "ra=06 24 52.76;dec=+16 03 26.0;mag=6.35;" star["HD 35775"] = "ra=05 27 15.40;dec=+02 20 28.3;mag=6.36;" star["HD 42351"] = "ra=06 11 01.77;dec=+18 07 49.7;mag=6.37;" star["HD 43358"] = "ra=06 15 53.98;dec=+01 10 08.4;mag=6.37;" star["HD 36058"] = "ra=05 28 56.91;dec=-03 18 26.7;mag=6.39;" star["θ2 Ori B"] = "ra=05 35 26.40;dec=-05 25 00.7;mag=6.38;fd=43;" star["HD 43335"] = "ra=06 16 23.79;dec=+17 10 53.9;mag=6.39;" star["HD 34880"] = "ra=05 20 26.41;dec=-05 22 03.1;mag=6.40;" star["V1377 Ori"] = "ra=05 35 35.90;dec=-03 15 10.2;mag=6.40;" star["HD 35656"] = "ra=05 26 38.82;dec=+06 52 07.5;mag=6.41;" star["HD 35912"] = "ra=05 28 01.47;dec=+01 17 53.7;mag=6.41;" star["HD 37904"] = "ra=05 41 40.31;dec=-02 53 47.5;mag=6.41;" star["HD 31423"] = "ra=04 56 09.02;dec=+07 54 17.3;mag=6.42;" star["HD 34317"] = "ra=05 16 41.05;dec=+01 56 50.4;mag=6.42;" star["HD 34878"] = "ra=05 20 43.74;dec=+02 32 41.0;mag=6.43;" star["V1357 Ori"] = "ra=06 13 12.46;dec=+10 37 40.3;mag=6.44;" star["HD 35575"] = "ra=05 25 36.50;dec=-01 29 28.7;mag=6.44;" star["HD 32273"] = "ra=05 02 00.03;dec=+01 36 31.8;mag=6.45;" star["HD 36814"] = "ra=05 34 02.48;dec=-07 01 25.1;mag=6.45;" star["V1389 Ori"] = "ra=06 12 59.57;dec=+06 00 58.6;mag=6.45;" star["HD 37808"] = "ra=05 40 46.19;dec=-10 24 31.2;mag=6.46;" star["V1369 Ori"] = "ra=05 21 19.31;dec=+04 00 43.1;mag=6.49;" star["HD 36150"] = "ra=05 29 41.59;dec=-00 48 08.7;mag=6.49;" star["HD 37635"] = "ra=05 39 30.84;dec=-09 42 23.8;mag=6.49;" star["HD 31411"] = "ra=04 55 58.36;dec=+05 23 56.6;mag=6.50;" star["HD 37150"] = "ra=05 36 15.03;dec=-05 38 52.5;mag=6.51;" star["HD 37808"] = "ra=05 40 46.19;dec=-10 24 31.1;mag=6.52;" star["HD 37017"] = "ra=05 35 21.87;dec=-04 29 39.0;mag=6.56;" star["σ Ori E"] = "ra=05 38 47.19;dec=-02 35 40.5;mag=6.61;fd=48;" star["HD 43317"] = "ra=06 15 47.01;dec=+04 17 01.1;mag=6.62;" star["σ Ori D"] = "ra=05 38 45.62;dec=-02 35 58.9;mag=6.62;fd=48;" star["θ1 Ori D"] = "ra=05 35 17.20;dec=-05 23 15.7;mag=6.71;fd=41;" star["θ1 Ori A"] = "ra=05 35 15.82;dec=-05 23 14.3;mag=6.73;fd=41;" star["HD 35155"] = "ra=05 22 18.64;dec=-08 35 58.0;mag=6.77;" star["Mintaka C"] = "ra=05 32 00.50;dec=-00 17 04.0;mag=6.83;fd=34;" star["HD 42618"] = "ra=06 12 01.0s;dec=+06 46 59″;mag=6.84;" star["KX Ori"] = "ra=05 35 04.79;dec=-04 43 54.6;mag=6.90;" star["Gliese 205"] = "ra=05 31 27.50;dec=-03 40 38.0;mag=6.97;" star["V901 Ori"] = "ra=05 40 56.37;dec=-01 30 25.9;mag=6.97;" edge["Ori"] = "1=Betelgeuse-Alnitak A;2=Alnitak A-Saiph;3=Saiph-Rigel;" edge["Ori"] = edge["Ori"] + "4=Rigel-Mintaka AB;5=Mintaka AB-Bellatrix;" edge["Ori"] = edge["Ori"] + "6=Bellatrix-Betelgeuse;7=Betelgeuse-μ Ori;" edge["Ori"] = edge["Ori"] + "8=μ Ori-ξ Ori;9=ξ Ori-ν Ori;" edge["Ori"] = edge["Ori"] + "10=Bellatrix-ο2 Ori;11=ο2 Ori-π2 Ori;" edge["Ori"] = edge["Ori"] + "12=π2 Ori-π3 Ori;13=π3 Ori-π4 Ori;" edge["Ori"] = edge["Ori"] + "14=π4 Ori-π5 Ori;" radiant = "ra=06 15 00.00;dec=+16 00 00.0;" EndSub Sub Cal_Init ' Calendar | Initialize days of month WQ = Text.GetCharacter(34) CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) iDoM = "1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31;" months = "1=January;2=February;3=March;4=April;5=May;6=June;7=July;" months = months + "8=August;9=September;10=October;11=November;12=December;" symbols = "1=♑;2=♒;3=♓;4=♈;5=♉;6=♊;7=♋;8=♌;9=♍;10=♎;11=♏;12=♐;" EndSub Sub Cal_DrawMonth ' Calendar | Print month ' param iM - month ' param iDoY - days of year ' param iWoY - week of year If silverlight Then Program.Delay(msWait) EndIf GraphicsWindow.FontSize = 16 GraphicsWindow.FontName = "Consolas" iW = Math.Remainder((iDoY + iWoY), 7) line = "SUN MON TUE WED THU FRI SAT" + CRLF iWoM = 0 While iWoM < iW line = line + " " iWoM = iWoM + 1 EndWhile For iD = 1 To iDoM[iM] If iD < 10 Then line = line + " " + iD + " " Else line = line + " " + iD + " " EndIf If Math.Remainder(iWoM, 7) = 6 Then line = line + CRLF EndIf iWoM = iWoM + 1 EndFor If Math.Remainder(iWoM, 7) > 0 Then line = line + CRLF EndIf cal = Shapes.AddText(line) Shapes.Move(cal, calendarX, calendarY) EndSub Sub Command_GetArgs ' Command line | Get arguments ' param sBuf - input buffer ' return sArg[] - arguments ' return iN - number of arguments iP = 1 ' buffer pointer iN = 1 ' number of args iC = Text.GetIndexOf(sBuf, ",") ' index of comma While iC > iP sArg[iN] = Text.GetSubText(sBuf, iP, iC - iP) iP = iC + 1 iN = iN + 1 iC = Text.GetIndexOf(sBuf, ",") EndWhile iE = Text.GetLength(sBuf) + 1 ' end of buffer sArg[iN] = Text.GetSubText(sBuf, iP, iE - iP) EndSub Sub SB_Workaround ' Small Basic | Workaround for Silverlight ' returns silverlight - "True" if in remote color = GraphicsWindow.GetPixel(0, 0) If Text.GetLength(color) > 7 Then silverlight = "True" msWait = 300 Else silverlight = "False" EndIf EndSub End>QMS609.sb< Start>QMV432-0.sb< ' Original by mahreen miangul, SeptEmbeR 2019 ' Modified by Nonki Takahashi GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Width = 800 GraphicsWindow.Height = 500 GraphicsWindow.BackgroundColor = "Cornsilk" GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "Black" Init() Anime() Program.Delay(2000) angle = 15 duration = 1000 center = "x=420;y=230;" Rotate() Program.Delay(duration) angle = -30 Rotate() Program.Delay(duration) angle = 15 Rotate() Sub Anime n = Array.GetItemCount(data) For i = 1 To n d = data[i] If Array.ContainsIndex(d, "sx") Then _sx = d["sx"] _sy = d["sy"] ElseIf Array.ContainsIndex(d, "c") Then GraphicsWindow.BrushColor = d["c"] Else sx[i] = _sx sy[i] = _sy haroon[i] = Shapes.AddEllipse(_sx, _sy) Shapes.Move(haroon[i], d["x1"], d["y1"]) Shapes.Animate(haroon[i], d["x2"], d["y2"], d["d"]) EndIf EndFor EndSub Sub Rotate n = Array.GetItemCount(data) cx = center["x"] cy = center["y"] _a = Math.GetRadians(angle) For i = 1 To n x1 = Shapes.GetLeft(haroon[i]) + sx[i] - cx y1 = Shapes.GetTop(haroon[i]) + sy[i] - cy x2 = Math.Cos(_a) * x1 - Math.Sin(_a) * y1 + cx - sx[i] y2 = Math.Sin(_a) * x1 + Math.Cos(_a) * y1 + cy - sy[i] Shapes.Animate(haroon[i], x2, y2, duration) EndFor EndSub Sub Init data[1] = "sx=20;sy=20;" '-------------------------------------------------------Magnetic-Balls-Gold------------------------------------------------ data[2] = "c=Gold;" ' body data[3] = "x1=000;y1=0;x2=380;y2=190;d=2000;" data[4] = "x1=800;y1=0;x2=400;y2=190;d=2000;" data[5] = "x1=000;y1=0;x2=420;y2=190;d=2000;" data[6] = "x1=800;y1=0;x2=440;y2=190;d=2000;" data[7] = "x1=000;y1=0;x2=380;y2=210;d=2000;" data[8] = "x1=800;y1=0;x2=400;y2=210;d=2000;" data[9] = "x1=000;y1=0;x2=420;y2=210;d=2000;" data[10] = "x1=800;y1=0;x2=440;y2=210;d=2000;" data[11] = "x1=000;y1=0;x2=380;y2=230;d=2000;" data[12] = "x1=800;y1=0;x2=400;y2=230;d=2000;" data[13] = "x1=000;y1=0;x2=420;y2=230;d=2000;" data[14] = "x1=800;y1=0;x2=440;y2=230;d=2000;" data[15] = "x1=000;y1=0;x2=380;y2=250;d=2000;" data[16] = "x1=800;y1=0;x2=400;y2=250;d=2000;" data[17] = "x1=000;y1=0;x2=420;y2=250;d=2000;" data[18] = "x1=800;y1=0;x2=440;y2=250;d=2000;" data[19] = "x1=000;y1=0;x2=380;y2=270;d=2000;" data[20] = "x1=800;y1=0;x2=400;y2=270;d=2000;" data[21] = "x1=000;y1=0;x2=420;y2=270;d=2000;" data[22] = "x1=800;y1=0;x2=440;y2=270;d=2000;" data[23] = "x1=000;y1=0;x2=380;y2=290;d=2000;" data[24] = "x1=800;y1=0;x2=400;y2=290;d=2000;" data[25] = "x1=000;y1=0;x2=420;y2=290;d=2000;" data[26] = "x1=800;y1=0;x2=440;y2=290;d=2000;" '-------------------------------------------------------Magnetic-Balls-Navy------------------------------------------------ data[27] = "c=Navy;" ' eyes data[28] = "x1=000;y1=0;x2=380;y2=110;d=2000;" data[29] = "x1=800;y1=0;x2=440;y2=110;d=2000;" ' right leg data[30] = "x1=000;y1=0;x2=368;y2=290;d=2000;" data[31] = "x1=800;y1=0;x2=383;y2=303;d=2000;" data[32] = "x1=000;y1=500;x2=355;y2=300;d=2000;" data[33] = "x1=000;y1=500;x2=370;y2=313;d=2000;" data[34] = "x1=000;y1=500;x2=340;y2=310;d=2000;" data[35] = "x1=000;y1=500;x2=355;y2=322;d=2000;" ' left leg data[36] = "x1=800;y1=500;x2=455;y2=290;d=2000;" data[37] = "x1=800;y1=500;x2=440;y2=300;d=2000;" data[38] = "x1=000;y1=0;x2=470;y2=300;d=2000;" data[39] = "x1=000;y1=0;x2=455;y2=310;d=2000;" data[40] = "x1=000;y1=0;x2=485;y2=313;d=2000;" data[41] = "x1=000;y1=0;x2=470;y2=325;d=2000;" '-------------------------------------------------------Magnetic-Balls-Red----------------------------------------------- data[42] = "c=Red;" ' mouth data[43] = "x1=000;y1=0;x2=400;y2=150;d=2000;" data[44] = "x1=800;y1=0;x2=420;y2=150;d=2000;" ' right arm data[45] = "x1=000;y1=0;x2=320;y2=190;d=2000;" data[46] = "x1=800;y1=0;x2=340;y2=190;d=2000;" data[47] = "x1=800;y1=0;x2=360;y2=190;d=2000;" data[48] = "x1=000;y1=0;x2=320;y2=210;d=2000;" data[49] = "x1=800;y1=0;x2=340;y2=210;d=2000;" data[50] = "x1=800;y1=0;x2=360;y2=210;d=2000;" ' left arm data[51] = "x1=000;y1=0;x2=460;y2=190;d=2000;" data[52] = "x1=800;y1=0;x2=480;y2=190;d=2000;" data[53] = "x1=800;y1=0;x2=500;y2=190;d=2000;" data[54] = "x1=000;y1=0;x2=480;y2=210;d=2000;" data[55] = "x1=800;y1=0;x2=460;y2=210;d=2000;" data[56] = "x1=800;y1=0;x2=500;y2=210;d=2000;" '-------------------------------------------------------Magnetic-Balls-Gainsboro"------------------------------------------------ data[57] = "c=Gainsboro" ' head data[58] = "x1=800;y1=0;x2=340;y2=90;d=2000;" data[59] = "x1=000;y1=0;x2=360;y2=90;d=2000;" data[60] = "x1=800;y1=0;x2=380;y2=90;d=2000;" data[61] = "x1=000;y1=0;x2=400;y2=90;d=2000;" data[62] = "x1=800;y1=0;x2=420;y2=90;d=2000;" data[63] = "x1=800;y1=0;x2=440;y2=90;d=2000;" data[64] = "x1=000;y1=0;x2=400;y2=90;d=2000;" ' dup with 61 data[65] = "x1=800;y1=0;x2=460;y2=90;d=2000;" data[66] = "x1=800;y1=0;x2=480;y2=90;d=2000;" data[67] = "x1=800;y1=0;x2=340;y2=70;d=2000;" data[68] = "x1=000;y1=0;x2=360;y2=70;d=2000;" data[69] = "x1=800;y1=0;x2=380;y2=70;d=2000;" data[70] = "x1=000;y1=0;x2=400;y2=70;d=2000;" data[71] = "x1=800;y1=0;x2=420;y2=70;d=2000;" data[72] = "x1=800;y1=0;x2=440;y2=70;d=2000;" data[73] = "x1=000;y1=0;x2=400;y2=70;d=2000;" ' dup with 70 data[74] = "x1=800;y1=0;x2=460;y2=70;d=2000;" data[75] = "x1=800;y1=0;x2=480;y2=70;d=2000;" data[76] = "x1=800;y1=0;x2=340;y2=170;d=2000;" data[77] = "x1=000;y1=0;x2=360;y2=170;d=2000;" data[78] = "x1=800;y1=0;x2=380;y2=170;d=2000;" data[79] = "x1=800;y1=0;x2=420;y2=170;d=2000;" data[80] = "x1=800;y1=0;x2=440;y2=170;d=2000;" data[81] = "x1=000;y1=0;x2=400;y2=170;d=2000;" data[82] = "x1=800;y1=0;x2=460;y2=170;d=2000;" data[83] = "x1=800;y1=0;x2=480;y2=170;d=2000;" data[84] = "x1=800;y1=0;x2=340;y2=150;d=2000;" data[85] = "x1=000;y1=0;x2=360;y2=150;d=2000;" data[86] = "x1=800;y1=0;x2=380;y2=150;d=2000;" data[87] = "x1=800;y1=0;x2=440;y2=150;d=2000;" data[88] = "x1=000;y1=0;x2=460;y2=150;d=2000;" data[89] = "x1=800;y1=0;x2=480;y2=150;d=2000;" data[90] = "x1=800;y1=0;x2=340;y2=130;d=2000;" data[91] = "x1=000;y1=0;x2=360;y2=130;d=2000;" data[92] = "x1=800;y1=0;x2=380;y2=130;d=2000;" data[93] = "x1=800;y1=0;x2=420;y2=130;d=2000;" data[94] = "x1=800;y1=0;x2=440;y2=130;d=2000;" data[95] = "x1=800;y1=0;x2=400;y2=130;d=2000;" data[96] = "x1=800;y1=0;x2=460;y2=130;d=2000;" data[97] = "x1=800;y1=0;x2=480;y2=130;d=2000;" data[98] = "x1=800;y1=0;x2=340;y2=110;d=2000;" data[99] = "x1=000;y1=0;x2=360;y2=110;d=2000;" data[100] = "x1=800;y1=0;x2=400;y2=110;d=2000;" data[101] = "x1=000;y1=0;x2=420;y2=110;d=2000;" data[102] = "x1=800;y1=0;x2=460;y2=110;d=2000;" data[103] = "x1=000;y1=0;x2=480;y2=110;d=2000;" ' right hand data[104] = "x1=800;y1=0;x2=260;y2=190;d=2000;" data[105] = "x1=000;y1=0;x2=280;y2=190;d=2000;" data[106] = "x1=800;y1=0;x2=300;y2=190;d=2000;" data[107] = "x1=000;y1=0;x2=260;y2=210;d=2000;" data[108] = "x1=000;y1=0;x2=280;y2=210;d=2000;" data[109] = "x1=000;y1=0;x2=300;y2=210;d=2000;" ' left hand data[110] = "x1=000;y1=0;x2=520;y2=190;d=2000;" data[111] = "x1=000;y1=0;x2=540;y2=190;d=2000;" data[112] = "x1=000;y1=0;x2=560;y2=190;d=2000;" data[113] = "x1=000;y1=0;x2=520;y2=210;d=2000;" data[114] = "x1=000;y1=0;x2=540;y2=210;d=2000;" data[115] = "x1=000;y1=0;x2=560;y2=210;d=2000;" ' right foot data[116] = "x1=000;y1=0;x2=325;y2=325;d=2000;" data[117] = "x1=000;y1=0;x2=338;y2=335;d=2000;" data[118] = "x1=000;y1=0;x2=310;y2=340;d=2000;" data[119] = "x1=000;y1=0;x2=325;y2=348;d=2000;" data[120] = "x1=000;y1=0;x2=297;y2=355;d=2000;" data[121] = "x1=000;y1=0;x2=313;y2=363;d=2000;" ' left foot data[122] = "x1=000;y1=0;x2=500;y2=325;d=2000;" data[123] = "x1=000;y1=0;x2=485;y2=340;d=2000;" data[124] = "x1=000;y1=0;x2=515;y2=335;d=2000;" data[125] = "x1=000;y1=0;x2=500;y2=350;d=2000;" data[126] = "x1=000;y1=0;x2=530;y2=345;d=2000;" data[127] = "x1=000;y1=0;x2=520;y2=360;d=2000;" EndSub End>QMV432-0.sb< Start>QMV432.sb< GraphicsWindow.Title = "mahreen miangul GraphicsWindow.Width = 800 GraphicsWindow.Height = 500 GraphicsWindow.BackgroundColor = "cornsilk 'MX= GraphicsWindow.MouseX 'MY= GraphicsWindow.MouseY 'GraphicsWindow.brushcolor=GraphicsWindow.GetRandomColor() ' "rosybrown" 'endsub GraphicsWindow.penWidth = 2 GraphicsWindow.pencolor = "black '-------------------------------------------------------Magnetic-Balls-Gold------------------------------------------------ GraphicsWindow.brushcolor= "Gold haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 230, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 230, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 230, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 230, 2000) 'Shapes.Rotate(haroon, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 250, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 250, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 250, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 250, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 270, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 270, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 270, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 270, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 290, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 290, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 290, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 290, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) '-------------------------------------------------------Magnetic-Balls-Navy------------------------------------------------ GraphicsWindow.brushcolor= "Navy haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 380, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 110, 2000) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 368, 290, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 383, 303, 2000) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 500) Shapes.Animate(haroon, 355, 300, 2000) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 500) Shapes.Animate(haroon, 370, 313, 2000) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 500) Shapes.Animate(haroon, 340, 310, 2000) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 500) Shapes.Animate(haroon, 355, 322, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 500) Shapes.Animate(haroon, 455, 290, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 500) Shapes.Animate(haroon, 440, 300, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 470, 300, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 455, 310, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 485, 313, 2000) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 470, 325, 2000) '-------------------------------------------------------Magnetic-Balls-Red----------------------------------------------- GraphicsWindow.brushcolor= "red haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 420, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 320, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 360, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 320, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 360, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 460, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 500, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 480, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 500, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) '-------------------------------------------------------Magnetic-Balls-Gainsboro"------------------------------------------------ GraphicsWindow.brushcolor= "Gainsboro haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 360, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 380, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 420, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 90, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 360, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 380, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 420, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 70, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 360, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 380, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 420, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 400, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 170, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 360, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 380, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 150, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 360, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 380, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 420, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 440, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 480, 130, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 340, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 360, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 400, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 420, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 460, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 480, 110, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 260, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 280, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addellipse(20, 20) Shapes.Move(haroon, 800, 0) Shapes.Animate(haroon, 300, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 260, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 280, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 300, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 520, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 540, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 560, 190, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 520, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 540, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 560, 210, 2000) 'Shapes.Rotate(haroon, 0) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 325, 325, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 338, 335, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 310, 340, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 325, 348, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 297, 355, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 313, 363, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 500, 325, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 485, 340, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 515, 335, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 500, 350, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 530, 345, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) haroon = shapes.addEllipse(20, 20) Shapes.Move(haroon, 0, 0) Shapes.Animate(haroon, 520, 360, 2000) Shapes.Rotate(haroon, 30) 'Shapes.Zoom(haroon, 0, 0) End>QMV432.sb< Start>QMW162.sb< texttodecode = "ehdtearosrid" ' theredroadis pos = Text.GetLength(texttodecode) '4,21,753,1083,1211,9 start = 4 TextWindow.Write(Text.GetSubText(texttodecode, start, 1)) secondpart() Sub secondpart TextWindow.Write(Text.GetSubText(texttodecode,start/2,1)) TextWindow.Write(Text.GetSubText(texttodecode,start-3,1)) endsub start = 7 While numbers < (pos-6) firstnumber = Text.GetSubText(texttodecode, start, 1) TextWindow.Write(firstnumber) secondnumber= Text.GetSubText(texttodecode, (start-2), 1) TextWindow.Write(secondnumber) thirdnumber = Text.GetSubText(texttodecode,(start-4),1) TextWindow.Write(thirdnumber) 'TextWindow.Pause() numbers = numbers +3 start = start +3 endwhile start=pos thirdpart() Sub thirdpart TextWindow.Write(Text.GetSubText(texttodecode,start,1)) TextWindow.Write(Text.GetSubText(texttodecode,start-1,1)) TextWindow.Write(Text.GetSubText(texttodecode,start-3,1)) endsub End>QMW162.sb< Start>QND161.sb< 'Set graphics window gw=800'Desktop.Width gh=600'Desktop.Height GraphicsWindow.Width=gw GraphicsWindow.Height=gh GraphicsWindow.CanResize="false" GraphicsWindow.BackgroundColor="Black" GraphicsWindow.MouseMove = OnMouseMove 'Set suns nsun=50 size=10 Ang=0.1 gsize=Math.Min(gw,gh) For i=1 To nsun GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor() sun=shapes.AddEllipse(size,size) Array.SetValue("suns",i,sun) Array.SetValue("X",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("Y",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("Z",i,Math.GetRandomNumber(gsize/2)) Array.SetValue("U",i,Ang*(Array.GetValue("Y",i)-gsize/2)) Array.SetValue("V",i,-Ang*(Array.GetValue("X",i)-gsize/2)) Array.SetValue("W",i,0) EndFor 'Move suns dt=1 grav=10 fric=0.0 While("true") For i=1 To nsun Xacc=0 Yacc=0 Zacc=0 For j=1 To nsun If (i <> j) Then Xdist=Array.GetValue("X",j)-Array.GetValue("X",i) Ydist=Array.GetValue("Y",j)-Array.GetValue("Y",i) Zdist=Array.GetValue("Z",j)-Array.GetValue("Z",i) dist2=Xdist*Xdist+Ydist*Ydist+Zdist*Zdist dist2=Math.Max(dist2,100) Xacc=Xacc+grav*Xdist/dist2 Yacc=Yacc+grav*Ydist/dist2 Zacc=Zacc+grav*Zdist/dist2 EndIf EndFor array.SetValue("AccX",i,Xacc) array.SetValue("AccY",i,Yacc) array.SetValue("AccZ",i,Zacc) EndFor For i=1 To nsun array.SetValue("U",i,(1-fric)*array.GetValue("U",i)+dt*array.GetValue("AccX",i)) array.SetValue("V",i,(1-fric)*array.GetValue("V",i)+dt*array.GetValue("AccY",i)) array.SetValue("W",i,(1-fric)*array.GetValue("W",i)+dt*array.GetValue("AccZ",i)) array.SetValue("X",i,array.GetValue("X",i)+dt*array.GetValue("U",i)) array.SetValue("Y",i,array.GetValue("Y",i)+dt*array.GetValue("V",i)) array.SetValue("Z",i,array.GetValue("Z",i)+dt*array.GetValue("W",i)) EndFor While (Mouse.IsLeftButtonDown) For i=1 To nsun x=array.GetValue("X",i)*Math.Cos(Xeye)+array.GetValue("Z",i)*Math.Sin(Xeye) z=-array.GetValue("X",i)*Math.Sin(Xeye)+array.GetValue("Z",i)*Math.Cos(Xeye) array.SetValue("X",i,x) array.SetValue("Z",i,z) y=array.GetValue("Y",i)*Math.Cos(Yeye)+array.GetValue("Z",i)*Math.Sin(Yeye) z=-array.GetValue("Y",i)*Math.Sin(Yeye)+array.GetValue("Z",i)*Math.Cos(Yeye) array.SetValue("Y",i,y) array.SetValue("Z",i,z) EndFor x=0 y=0 For i=1 To nsun x=x+array.GetValue("X",i) y=y+array.GetValue("Y",i) EndFor x=x/nsun y=y/nsun For i=1 To nsun array.SetValue("X",i,array.GetValue("X",i)-(x-gw/2)) array.SetValue("Y",i,array.GetValue("Y",i)-(y-gh/2)) sun=array.GetValue("suns",i) Shapes.Move(sun,array.GetValue("X",i),array.GetValue("Y",i)) EndFor EndWhile x=0 y=0 For i=1 To nsun x=x+array.GetValue("X",i) y=y+array.GetValue("Y",i) EndFor x=x/nsun y=y/nsun For i=1 To nsun array.SetValue("X",i,array.GetValue("X",i)-(x-gw/2)) array.SetValue("Y",i,array.GetValue("Y",i)-(y-gh/2)) sun=array.GetValue("suns",i) Shapes.Move(sun,array.GetValue("X",i),array.GetValue("Y",i)) EndFor EndWhile Sub OnMouseMove Xeye=-(GraphicsWindow.MouseX-gw/2)/10000 Yeye=-(GraphicsWindow.MouseY-gh/2)/10000 EndSub End>QND161.sb< Start>QNL136.sb< start: TextWindow.WriteLine("let´s start with 15") count = 15 TextWindow.WriteLine("Do you want to turn 1,2 or 3 ?") turn = TextWindow.Read() count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine(" your opponents turn") Program.Delay(2000) turn = Math.GetRandomNumber(3) count = count - turn If (count <= 0) Then Goto win EndIf TextWindow.WriteLine(count) TextWindow.WriteLine("your turn") turn = TextWindow.Read() count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine(" your opponents turn") Program.Delay(2000) turn = Math.GetRandomNumber(3) count = count - turn If (count <= 0) Then Goto win EndIf TextWindow.WriteLine(count) TextWindow.WriteLine("your turn") turn = TextWindow.Read() count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine(" your opponents turn") Program.Delay(2000) turn = Math.GetRandomNumber(3) count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine("your turn") turn = TextWindow.Read() count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine(" your opponents turn") Program.Delay(2000) turn = Math.GetRandomNumber(3) count = count - turn If (count <= 0) Then Goto win EndIf TextWindow.WriteLine(count) TextWindow.WriteLine("your turn") turn = TextWindow.Read() count = count - turn If (count <= 0) Then Goto end EndIf TextWindow.WriteLine(count) TextWindow.WriteLine(" your opponents turn") Program.Delay(2000) turn = Math.GetRandomNumber(3) count = count - turn If (count <= 0) Then Goto win EndIf End: TextWindow.WriteLine("You Loose!") Goto finish win: TextWindow.WriteLine("You Win!") finish: TextWindow.WriteLine("Retry? (1/0)") retry = TextWindow.ReadNumber() If (retry = 1) Then Goto start EndIf End>QNL136.sb< Start>QNM769.sb< GraphicsWindow.Width=800 GraphicsWindow.Height=900 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.Title="Text Sensing tt="T.h.e. .a.u.t.u.m.n. .l.e.a.v.e.s. .a.r.e. .f.a.l.l.i.n.g. .d.o.w.n. .t.o. .s.t.r.e.e.t.:. .L.o.r.e.m. .i.p.s.u.m. .d.o.l.o.r. .s.i.t. .a.m.e.n.t. .n.o.n.n.u.m. .u.n.a.m. .e.i.u.n.m.o.d.:. " GraphicsWindow.PenWidth=0 cc[1]=LDText.Split (tt ".") ww= Array.GetItemCount (cc[1]) cc[1]=ldtext.Replace (cc[1] ":" ".") GraphicsWindow.FontName="Calibri GraphicsWindow.FontSize=22 GraphicsWindow.BrushColor=LDColours.HSLtoRGB (30 .8 .2) GraphicsWindow.FillRectangle (0 0 1200 1000) GraphicsWindow.BrushColor="black ee=Shapes.AddEllipse (300 300) Shapes.Move (ee 300 70) ee1=ldShapes.AddStar (5 90 190) Shapes.Move (ee1 260 400) ii=LDGraphicsWindow.Capture ("" "false") Shapes.HideShape (ee) Shapes.HideShape (ee1) ff=.9 px=30 For r=1 To ww c[1][r]=ldtext.GetWidth(cc[1][r]) Program.Delay (5) EndFor gw= 1000 GraphicsWindow.BrushColor="white py=40 px=170 For y=1 To 5 ci=1 r=1 while r<= ww ll=LDImage.GetPixel (ii px py) if ll="#FF000000" then s=Shapes.AddText ( cc[1][r]) Shapes.move (s px py) LDShapes.AnimateOpacity (s 1500 10) LDShapes.AnimateZoom (s 700 15 1.5 1.5) px=px+c[1][r] r=r+1 Else px=px+5 If px>700 then px=170 py=py+35 endif endif EndWhile EndFor End>QNM769.sb< Start>QNN007.sb< title = "Curves" ver = "" LDUtilities.ShowNoShapeErrors="False GraphicsWindow.BackgroundColor="#aabbcc cc=0 lsc=0 inn=0 inpn=0 lmd=1 nct=12 Shapes.AddEllipse(2,2) LDDialogs.AddRightClickMenu(LDText.Split ("AllOFF NodesON NodesOFF LinesON LinesOFF ShwON ShwOFF"," "),"") LDDialogs.RightClickMenu =rmmn GraphicsWindow.KeyDown=kdd GraphicsWindow.Title = title + " " + ver + " - Quadratic Bezier Curve" Not = "False=True;True=False;" nth = "1=first;2=second;3=third;4=fourth;" Form() i=1 while i < nct tsl=0 msg = "Click "+ nth[i] + " point on the screen." ShowInstruction() GetPoint() If FCKeyboard.IsControlPressed and i>2 Then ox=px[i-2] nx=px[i-1] oy=py[i-2] ny=py[i-1] aag= mathplus.GetDegrees ( MathPlus.ATan2(nx-ox,ny-oy)+Math.Pi/2) If aag>180 Then aag=aag-360 elseIf aag<-180 Then aag=aag+360 endif aag=math.Round(aag) ' rr=ldmath.Convert2Radial (px[i-1],py[i-1],px[i-2],py[i-2]) dx=x-px[i-1] dy=y-py[i-1] dst=math.SquareRoot (dx*dx+dy*dy) qq= LDMath.Convert2Cartesian (px[i-1],py[i-1],dst,aag-90 ) 'GraphicsWindow.Title=aag+" : "+dst x=qq[1] y=qq[2] endif ShowPoint() px[i] = x py[i] = y i=i+1 Endwhile msg = "" ShowInstruction() GraphicsWindow.PenColor = "Gray" For c=0 to nct-4 step 2 dpx[1]=px[1+c] dpy[1]=py[1+c] dpx[2]=px[2+c] dpy[2]=py[2+c] dpx[3]=px[3+c] dpy[3]=py[3+c] GraphicsWindow.PenColor="Gray lsc=lsc+1 ls[lsc]=Shapes.AddLine (dpx[1], dpy[1], dpx[2], dpy[2]) lsc=lsc+1 ls[lsc]=Shapes.AddLine (dpx[2], dpy[2], dpx[3], dpy[3]) GraphicsWindow.PenColor="Red crc=c+1 DrawQuadraticBezier() endfor GraphicsWindow .MouseMove =mmww While 1=1 Program.Delay(5) If dopann=1 and inn=0 And inpn=0 Then inn=1 mpan () inn=0 dopann =0 Endif endwhile '---------------------------------subs---------------------------------**************************************** Sub rmmn lm= LDDialogs.LastRightClickMenuItem If lm=1 Then For x=1 To cc Shapes.HideShape (cs[x]) EndFor For x=1 To lsc Shapes.HideShape (ls[x]) EndFor lmd=0 elseIf lm=2 Then For x=1 To cc Shapes.ShowShape (cs[x]) EndFor elseIf lm=3 Then For x=1 To cc Shapes.HideShape (cs[x]) EndFor elseIf lm=4 Then For xx=1 To lsc Shapes.showShape (ls[xx]) EndFor lmd=1 elseIf lm=5 Then For x=1 To lsc Shapes.HideShape (ls[x]) EndFor lmd=0 elseIf lm=6 Then ssln=1 elseIf lm=7 Then ssln=0 endif EndSub Sub kdd lky=GraphicsWindow.LastKey GraphicsWindow.Title =lky If lky="Back" Then Shapes.Remove (cs[cc]) cc=cc-1 i=i-1 ElseIf lky="Tab" then tsl=tsl+1 If tsl=nct then tsl=1 endif For kx=1 to nct-1 LDShapes.BrushColour (cs[kx],"Blue") endfor LDShapes.BrushColour (cs[tsl],"Red") endif EndSub Sub Form gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 20 instruction = Shapes.AddText("") Shapes.Move(instruction, 10, 10) GraphicsWindow.MouseDown = OnMouseDown EndSub Sub DrawQuadraticBezier ' param px, py - array of three control points for quadratic Bezier curve ff=0 For k = 0 To 1 Step 0.05 x1 = dpx[1] + k * (dpx[2] - dpx[1]) y1 = dpy[1] + k * (dpy[2] - dpy[1]) x2 = dpx[2] + k * (dpx[3] - dpx[2]) y2 = dpy[2] + k * (dpy[3] - dpy[2]) GraphicsWindow.PenColor = "Gray" if ssln=1 then line = Shapes.AddLine(x1, y1, x2, y2) EndIf x = x1 + k * (x2 - x1) y = y1 + k * (y2 - y1) If 0 < k Then ff=ff+1 GraphicsWindow.PenColor = "Red dline[crc][ff] = Shapes.AddLine(_x, _y, x, y) EndIf _x = x ' last x _y = y ' last y msg = "k = " + k If ssln=1 then Program.Delay(30) Shapes.Remove(line) EndIf EndFor EndSub Sub GetPoint ' return x, y - clicked point mouseDown = "False" While Not[mouseDown] Program.Delay(300) EndWhile x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY EndSub Sub mmww if Mouse.IsLeftButtonDown then mx= GraphicsWindow.MouseX my= GraphicsWindow.MouseY If (mx<>omx Or my<>omy) Then dopann=1 endif omx=x omy=y EndIf EndSub Sub OnMouseDown mouseDown = "True" if mouse.IsLeftButtonDown then mpan() endif EndSub Sub mpan If tsl>0 Then inpn=1 x= GraphicsWindow.MouseX y= GraphicsWindow.MouseY If FCKeyboard.IsControlPressed and tsl>2 Then i=tsl ox=px[i-2] nx=px[i-1] oy=py[i-2] ny=py[i-1] aag= mathplus.GetDegrees ( MathPlus.ATan2(nx-ox,ny-oy)+Math.Pi/2) If aag>180 Then aag=aag-360 elseIf aag<-180 Then aag=aag+360 endif aag=math.Round(aag) ' rr=ldmath.Convert2Radial (px[i-1],py[i-1],px[i-2],py[i-2]) dx=x-px[i-1] dy=y-py[i-1] dst=math.SquareRoot (dx*dx+dy*dy) qq= LDMath.Convert2Cartesian (px[i-1],py[i-1],dst,aag-90 ) 'GraphicsWindow.Title=aag+" : "+dst x=qq[1] y=qq[2] endif px[tsl ] = x py[tsl ] = y ldShapes.Centre (cs[tsl], x,Y ) Shapes.Remove (ls[tsl]) Shapes.Remove (ls[tsl-1]) If tsl>1 and lmd=1 then ls[tsl-1]=Shapes.AddLine (x,y,px[tsl-1],py[tsl-1]) EndIf If tsl1 then DrawQuadraticBezier() endif dpx [3]=px[tsl+2] dpy [3]=py[tsl+2] dpx [1]=x dpy [1]=y dpx [2]=px[tsl+1] dpy [2]=py[tsl+1] crc=tsl If tsl2 Then LDShapes.BrushColour (cs[cc],"Brown") Else LDShapes.BrushColour (cs[cc],"Blue") EndIf EndSub End>QNN007.sb< Start>QNN392.sb< args=0 GraphicsWindow.Title="3D Plot Demo GraphicsWindow.BackgroundColor="tan GraphicsWindow.PenWidth=.7 Sub ff cc=Math.Cos(args[1]/16) return=30*cc*cc EndSub Sub drw py=0 For x=-30 To 30 Step .5 l=0 y1=5*Math.Floor(Math.SquareRoot(900-x*x)/5) For y=y1 To -y1 Step -2 z=Math.Floor(25+ldcall.Function("ff" Math.SquareRoot(x*x+y*y))-.7*y) If z<=l Then Goto nxt Else l=z EndIf If ox>0 and lmm Then GraphicsWindow.DrawLine(ox oy py 300-z*4) EndIf ox=py oy=300-z*4 If lmm Then Else GraphicsWindow.FillEllipse(py 300-z*4 3 3) EndIf nxt: EndFor ox=0 py=py+3 EndFor EndSub GraphicsWindow.PenColor="yellow" GraphicsWindow.PenWidth=4 lmm="true drw() GraphicsWindow.BrushColor="darkblue" lmm="false drw() End>QNN392.sb< Start>QNP528.sb< '=========================================================== ' A SIMPLE 3D MAZE GAME for SMALL BASIC using LITDEV extension '=========================================================== LDGraphicsWindow.State = 2 gw = GraphicsWindow.Width gh = GraphicsWindow.Height GraphicsWindow.BackgroundColor = "midnightblue GraphicsWindow.Title = "3D Cone Maze" user = "q" wallImg = ImageList.LoadImage("e:/stone.png") stonesImg = ImageList.LoadImage("e:/grass.png") waterImg = ImageList.LoadImage("http://www.totnutoe.nl/tiles/Water Block.png") args = "" 'For use with LDCall speed = 1 'Control speed size = 1 ' The image per tile scaling proximity = size/10 'Closest approach to an object While "true GraphicsWindow.Clear() 'Create a view view3D = LD3DView.AddView(gw,gh,"True") 'Will not clip to size if window rescaled creation = Shapes.AddText("Creating Scene") LD3DView.AutoControl2 (1 1) createCone() createBasicWall() 'Animation end event LD3DView.TranslationCompleted = OnTranslationCompleted ' X is an empty room ' L is a room with a light ' C is a room with a rotating illuminated cone layout = "" layout[15] = "LUX LXXXXXXXXXXXXXXXLXXXU" layout[14] = "X X XXLXX X U X XCX " layout[13] = "XXLXX X X U X L " layout[12] = "L C XXL XL X LXXXXXXXLXXXXX" layout[11] = "XXX L X X LXXXX X XCX" layout[10] = "L XXXXXX X L X XXLXXXLXXXLX" layout[9] = "X X L XXXXLXXXXXXXXL X X X" layout[8] = " X X X L X XLXX" layout[7] = "LXXX LXXXXXXXXXXXLXXXXXX L X X" layout[6] = "C X XLXX X X XXXXX L " layout[5] = "XXLXX X XXXX LXXXXXXX L X" layout[4] = "L X XXL XL X XXXXXXXXXX" layout[3] = "XXX L X XXXXXXXLXXXX XCX" layout[2] = "X XXXXXX X X XXLXXXXXXXLX" layout[1] = "UXL XX XLXXXXXXXXXXXXXXXXXXXXLXXXXXXU" createWorld() LD3DView.AddAmbientLight(view3D,"#101010") 'Dim ambient light Shapes.Remove(creation) startTime = Clock.ElapsedMilliseconds progress = 0 While (progress < coneCount) start = Clock.ElapsedMilliseconds 'Use the keys to move the camera - comment S to prevent backwards movement out of the maze, or Up, Down, A and D to simplify movement yaw = 0 pitch = 0 roll = 0 move = 0 If (LDUtilities.KeyDown("Left")) Then yaw = yaw-1.5*speed EndIf If (LDUtilities.KeyDown("Right")) Then yaw = yaw+1.5*speed elseif (LDUtilities.KeyDown("Up")) Then pitch = pitch-1.5*speed elseif (LDUtilities.KeyDown("Down")) Then pitch = pitch+1.5*speed elseif(LDUtilities.KeyDown("A")) Then roll = roll+1.5*speed elseif (LDUtilities.KeyDown("D")) Then roll = roll-1.5*speed elseif (LDUtilities.KeyDown("W")) Then move = move+size/25*speed elseif(LDUtilities.KeyDown("S")) Then move = move-size/25*speed EndIf hit = LD3DView.HitTest(view3D,-1,-1) 'Prevent forward movement into an object If (hit <> "" And hit[2] < proximity) Then move = Math.Min(0,move) 'We can still back up For i = 1 To coneCount If (hit[1] = cone[i]) Then 'Remove cones as we find them LD3DView.ModifyObject(view3D,cone[i],"H") progress = progress+1 EndIf EndFor EndIf LD3DView.MoveCamera(view3D,yaw,pitch,roll,move) 'These are relative changes wrt current view If (LDUtilities.KeyDown("Escape")) Then Program.End() EndIf For kCone = 1 To coneCount If (startConeAnimation[kCone] = 1) Then startConeAnimation[kCone] = 0 LDCall.Function("animateCone",kCone) EndIf EndFor pos = LDCall.Function2("truncate",LD3DView.GetCameraPosition(view3D),2) dir = LDCall.Function2("truncate",LD3DView.GetCameraDirection(view3D),2) GraphicsWindow.Title = "Time = "+Math.Round((Clock.ElapsedMilliseconds-startTime)/1000)+" Cones remaining = "+(coneCount-progress)+" Position = ("+pos[1]+" , "+pos[2]+" , "+pos[3]+") Direction = "+dir[1]+" , "+dir[2]+" , "+dir[3]+")" delay = 20 - (Clock.ElapsedMilliseconds-start) If (delay > 0) Then Program.Delay(delay) EndIf EndWhile 'Game ends - check the scores Shapes.Remove(view3D) timesec = Math.Round((Clock.ElapsedMilliseconds-startTime)/1000) GraphicsWindow.DrawText(50,50,"You did it in "+timesec+" seconds") score = Math.Max(0,1000-timesec) hightscore = LDNetwork.HighScore("3DMazeGame2",user,score) GraphicsWindow.DrawText(50,100,"Your score is "+score) GraphicsWindow.DrawText(50,150,"The high score is "+hightscore[2]+" by "+hightscore[1]) Program.Delay (6666) endwhile'--------------------------------------------------------------------endmain------------------------------------- Sub createBasicWall points = "" indices = "" textures = "" index = 0 For i = 1 To size For j = 1 To size x1 = i-1 x2 = i y1 = j-1 y2 = j z = 0 'Triangle1 points = points+x1+":"+y1+":"+z+":" points = points+x2+":"+y1+":"+z+":" points = points+x2+":"+y2+":"+z+":" indices = indices + index+":"+(index+1)+":"+(index+2)+":" index = index+3 textures = textures + "0 0:0 1:1 1:" 'Triangle2 points = points+x1+":"+y1+":"+z+":" points = points+x2+":"+y2+":"+z+":" points = points+x1+":"+y2+":"+z+":" indices = indices + index+":"+(index+1)+":"+(index+2)+":" index = index+3 textures = textures + "0 0:1 1:1 0:" EndFor EndFor wall = LD3DView.AddGeometry(view3D,points,indices,"","White","D") LD3DView.AddImage(view3D,wall,textures,wallImg,"D") LD3DView.ModifyObject(view3D,wall,"H") EndSub Sub createWall i = args[1] 'Left to Right j = args[2] 'Front to Back k = args[3] 'Down to Up dir = args[4] If (dir = "F") Then return = LD3DView.CloneObject(view3D,wall) LD3DView.TranslateGeometry(view3D,return,i*size,k*size,-j*size) ElseIf (dir = "B") Then return = LD3DView.CloneObject(view3D,wall) LD3DView.RotateGeometry(view3D,return,0,1,0,180) LD3DView.TranslateGeometry(view3D,return,i*size,k*size,-j*size+size) ElseIf (dir = "L") Then return = LD3DView.CloneObject(view3D,wall) LD3DView.RotateGeometry(view3D,return,0,1,0,90) LD3DView.TranslateGeometry(view3D,return,i*size-size/2,k*size,-j*size+size/2) ElseIf (dir = "R") Then return = LD3DView.CloneObject(view3D,wall) LD3DView.RotateGeometry(view3D,return,0,1,0,-90) LD3DView.TranslateGeometry(view3D,return,i*size+size/2,k*size,-j*size+size/2) ElseIf (dir = "U") Then return = LD3DView.CloneObject(view3D,wall) 'D3DView.AddImage(view3D,return,textures,waterImg,"D") LD3DView.RotateGeometry(view3D,return,1,0,0,90) LD3DView.TranslateGeometry(view3D,return,i*size,k*size+size/2,-j*size+size/2) ElseIf (dir = "D") Then return = LD3DView.CloneObject(view3D,wall) If char="U" then LD3DView.AddImage(view3D,return,textures,waterImg "D") else LD3DView.AddImage(view3D,return,textures,stonesImg,"D") EndIf LD3DView.RotateGeometry(view3D,return,1,0,0,-90) LD3DView.TranslateGeometry(view3D,return,i*size,k*size-size/2,-j*size+size/2) EndIf LD3DView.Freeze(view3D,return) ' We won't ever modify this so freeze it EndSub Sub truncate 'Change the input array of numbers to the required number of decimal places------------------------------- return = args[1] sigfig = args[2] multiplier = Math.Power(10,sigfig) For i = 1 To Array.GetItemCount(return) return[i] = (1/multiplier)*Math.Round(multiplier*return[i]) EndFor EndSub Sub getChar 'Get layout character----------------------------------------------- i = args[1] j = args[2] return = Text.GetSubText(layout[i],j,1) If (return = " ") Then return = "" EndIf EndSub Sub createWorld' Crearte a maze layout - the large indexes are forward------------------------------------------- cameraSet = 0 coneCount = 0 For y = 1 To Array.GetItemCount(layout) Shapes.Remove(creation) creation = Shapes.AddText("Creating Scene "+Math.Round(100*(y)/(Array.GetItemCount(layout)))+"%") For x = 1 To Text.GetLength(layout[y]) char = LDCall.Function2("getChar",y,x) If (char <> "") Then If (cameraSet = 0) Then 'Initial camera position and direction and view angle LD3DView.ResetCamera(view3D,x*size+size/2,0.4*size,-size/2,0,0,-1,"","","") LD3DView.CameraProperties(view3D,0,30*size,60) ' limit to 30 blocks (the longest corridor) cameraSet = 1 'The first room is the start point EndIf LDCall.Function4("createWall",x,y,0,"U") 'Floor and ceiling LDCall.Function4("createWall",x,y,0,"D") If (LDCall.Function2("getChar",y,x-1) = "") Then 'Left and right walls LDCall.Function4("createWall",x,y,0,"L") EndIf If (LDCall.Function2("getChar",y,x+1) = "") Then LDCall.Function4("createWall",x,y,0,"R") EndIf If (LDCall.Function2("getChar",y-1,x) = "") Then 'Front and back walls LDCall.Function4("createWall",x,y,0,"B") EndIf If (LDCall.Function2("getChar",y+1,x) = "") Then LDCall.Function4("createWall",x,y,0,"F") EndIf 'Add a lit cone - these are the main performance limiters so keep this kind of thing to a minimum If (char = "C") Then color = LDColours.HSLtoRGB(Math.GetRandomNumber(360),1,0.5)' A random high brightness colour spot = LD3DView.AddSpotLight(view3D,color,x*size+size/2,size,-(y*size-size/2),0,-1,0,30,size/2) coneCount = coneCount+1 cone[coneCount] = LD3DView.AddGeometry(view3D,pointsCone,indicesCone,"",color,"D") 'A base colour LD3DView.AddImage(view3D,cone[coneCount],texturesCone,waterImg,"S") ' Some shiny texture that is stronly affected by lights LD3DView.TranslateGeometry(view3D,cone[coneCount],x*size+size/2,size/3,-(y*size-size/2)) LD3DView.AnimateRotation(view3D,cone[coneCount], 0, 1, 0, 0, 360, 3, -1) coneX[coneCount] = x coneY[coneCount] = y LDCall.Function("animateCone",coneCount) EndIf If (char = "L") Then 'Add a point light point = LD3DView.AddPointLight(view3D,"White",x*size+size/2,0.98*size,-(y*size-size/2),5*size) EndIf EndIf EndFor EndFor EndSub Sub createCone nside = 10 height = size/2 radius = size/4 pointsCone = "0:"+(2/3*height)+":0:" indicesCone = "" texturesCone = "0.5:1:" For i = 0 To nside angle = i/nside*2*Math.Pi x = radius*Math.Cos(-angle) y = radius*Math.Sin(-angle) pointsCone = pointsCone+x+":"+(-height/3)+":"+y+":" If (i < nside) Then indicesCone = indicesCone + "0:"+(i+1)+":"+(i+2)+":" Else indicesCone = indicesCone + "0:"+(i+1)+":"+1+":" EndIf texturesCone = texturesCone + i/nside+":0:" EndFor EndSub Sub animateCone iCone = args[1] 'Current position xPos = coneX[iCone] yPos = coneY[iCone] 'The 4 possible new positions newX[1] = xPos-1 newY[1] = yPos newX[2] = xPos newY[2] = yPos+1 newX[3] = xPos+1 newY[3] = yPos newX[4] = xPos newY[4] = yPos-1 'Check for directions we can move For iDir = 1 To 4 move[iDir] = LDCall.Function2("getChar",newY[iDir],newX[iDir]) EndFor 'coneMoveDir is the last direction 1 to 4 as listed above - start in +Y direction if unset If (coneMoveDir[iCone] = "") Then coneMoveDir[iCone] = 2 EndIf 'Find the forward, back, left and right wrt current direction dirForward = coneMoveDir[iCone] dirLeft = coneMoveDir[iCone]-1 If (dirLeft < 1) Then dirLeft = 4+dirLeft EndIf dirRight = coneMoveDir[iCone]-3 If (dirRight < 1) Then dirRight = 4+dirRight EndIf dirBack = coneMoveDir[iCone]-2 If (dirBack < 1) Then dirBack = 4+dirBack EndIf 'Move forward with high chance If (move[dirForward] <> "" And Math.GetRandomNumber(10) > 2) Then coneX[iCone] = newX[dirForward] coneY[iCone] = newY[dirForward] coneMoveDir[iCone] = dirForward Else 'If not then move left or right with 50% chance each - otherwise move back If (move[dirLeft] <> "" And Math.GetRandomNumber(2) = 1) Then coneX[iCone] = newX[dirLeft] coneY[iCone] = newY[dirLeft] coneMoveDir[iCone] = dirLeft ElseIf (move[dirRight] <> "") Then coneX[iCone] = newX[dirRight] coneY[iCone] = newY[dirRight] coneMoveDir[iCone] = dirRight ElseIf (move[dirLeft] <> "") Then 'Move left if we cannot go right coneX[iCone] = newX[dirLeft] coneY[iCone] = newY[dirLeft] coneMoveDir[iCone] = dirLeft ElseIf (move[dirBack] <> "") Then coneX[iCone] = newX[dirBack] coneY[iCone] = newY[dirBack] coneMoveDir[iCone] = dirBack ElseIf (move[dirForward] <> "") Then ' It is possible we can only go forward coneX[iCone] = newX[dirForward] coneY[iCone] = newY[dirForward] coneMoveDir[iCone] = dirForward EndIf EndIf 'Do the move LD3DView.AnimateTranslation(view3D,cone[iCone],coneX[iCone]*size+size/2,size/3,-(coneY[iCone]*size-size/2),1) EndSub Sub OnTranslationCompleted' Move the cone when its last translation is completed 'Handle rare possibility that a cone can 'get stuck' by ending its animation at the same time as another so check for all queued completed animations While (LD3DView.QueuedTranslationCompleted > 0) 'Almost always exactly one. lastCone = LD3DView.LastTranslationCompleted ' Get this value only once since it will dequeue any queued items For jCone = 1 To coneCount ' We use jCone because iCone and kCone are used elsewhere and we don't want them to conflict If (cone[jCone] = lastCone) Then startConeAnimation[jCone] = 1 EndIf EndFor EndWhile EndSub End>QNP528.sb< Start>QNW160.sb< 'add game play buttons, 1st create space for them: TOP for menu, BOTTOM for display 'ALSO fixing workaround for bug 'DEBUG() boxSize = 3 ribbonHeight = 25 GraphicsWindow.MouseDown = OnMouseDown Timer.Tick = OnTick Timer.Interval = 1000 InitialiseGraphicsWindow() box = Shapes.AddRectangle(boxSize, boxSize) ShowBox() 'initialise boxZoom and position, then hide. ????? Shapes.HideShape(box) GraphicsWindow.Show() While "True" If flag = "Box Clicked On" Then Sound.PlayChime() Program.Delay(300) HideBox() flag = "" ElseIf flag = "Show Box" Then ShowBox() flag = "" EndIf Program.Delay(20) EndWhile Sub OnTick Timer.Interval = Math.GetRandomNumber(2500) + 500 flag = "Show Box" EndSub Sub OnMouseDown If GraphicsWindow.MouseX >= boxX And GraphicsWindow.MouseX <= boxX + boxTrueSize Then If GraphicsWindow.MouseY >= boxY And GraphicsWindow.MouseY <= boxY + boxTrueSize Then flag = "Box Clicked On" 'can't run animation in event thread EndIf EndIf EndSub Sub ShowBox boxZoom = Math.GetRandomNumber(20 - 5) + 5 '5'20 boxZoomOffset = ((boxSize * boxZoom) - boxSize) / 2 TextWindow.WriteLine("boxZoomOffset " + boxZoomOffset) boxTrueSize = boxSize * boxZoom boxX = Math.GetRandomNumber(gw - (boxSize * boxZoom)) boxY = Math.GetRandomNumber(gh - (boxSize * boxZoom) - ribbonHeight * 2) + ribbonHeight Shapes.Zoom(box, boxZoom, boxZoom) Shapes.Move(box, boxX + boxZoomOffset, boxY + boxZoomOffset) Shapes.ShowShape(box) EndSub Sub HideBox While boxZoom > 0.5 boxZoom = boxZoom - 0.2 Shapes.Zoom(box, boxZoom, boxZoom) Program.Delay(5) EndWhile Shapes.HideShape(box) EndSub Sub InitialiseGraphicsWindow GraphicsWindow.Hide() gw = GraphicsWindow.Width gh = GraphicsWindow.Height GraphicsWindow.Left = (Desktop.Width - gw) / 2 GraphicsWindow.Top = 10 GraphicsWindow.BackgroundColor = "black" GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = "yellow" EndSub Sub DEBUG TextWindow.Title = "DEBUGGING" TextWindow.Left = 5 TextWindow.Top = 80 EndSub End>QNW160.sb< Start>QPB125.sb< start: TextWindow.Title = "Calculator" TextWindow.WriteLine("Press 1 for summation,2 for subtraction,3 for multiplication and 4 for division") a = TextWindow.Read() If a <> 1 Then Goto k Else Goto u endif u: TextWindow.WriteLine("First number: ") b = TextWindow.Read() TextWindow.WriteLine("Second number: ") c = TextWindow.Read() TextWindow.WriteLine("Result:") If a = 1 then TextWindow.WriteLine(b + c) endif If a = 2 then TextWindow.WriteLine(b - c) endif If a = 3 Then TextWindow.WriteLine(b * c) endif If a = 4 Then TextWindow.WriteLine(b / c) endif TextWindow.WriteLine("Do you wish to use the calculator again? 1=yes 2=no") d = TextWindow.Read() If d = 1 Then Goto start Else TextWindow.WriteLine("GoodBye!") Goto l EndIf k: TextWindow.WriteLine("The character that you wrote isnt a number between 1 and 4!") Goto start l: End>QPB125.sb< Start>QPB316-0.sb< GraphicsWindow.Title="Windmills GraphicsWindow.Width = 1200 GraphicsWindow.Height = 800 GraphicsWindow.Left=10 GraphicsWindow.top=10 ldGraphicsWindow.BackgroundBrush (LDShapes.BrushGradient ("1=yellowgreen;2=#004500" "V")) GraphicsWindow.BrushColor="skyblue GraphicsWindow.FillRectangle(0,00,1200,400) For x=1 to 320 If Math.Remainder (x 2)=0 Then GraphicsWindow.BrushColor="yellow Else GraphicsWindow.BrushColor="white EndIf GraphicsWindow.FillEllipse (Math.GetRandomNumber (1200) Math.GetRandomNumber(370)+410 6 6) endfor GraphicsWindow.BrushColor="Blue" GraphicsWindow.PenWidth=0 GraphicsWindow.FillTriangle(250,400,500,800,300,400) GraphicsWindow.FillTriangle(300,400,500,800,750,800) windmill_shapes() make_winmills() While "True For NMB=1 To 3 ss=s[NMB] For i=10 to array.GetItemCount(dat) angle[NMB][i]=angle[NMB][i]-10 _angle=math.GetRadians(angle[NMB][i]) Shapes.Move(SHP[NMB][i],XYC[NMB]["X"]+DR[NMB][i]*Math.Cos(_angle)-dat[i]["wd"]*ss/2,XYC[NMB]["Y"]+DR[NMB][i]*Math.sin(_angle)-dat[i]["ht"]*ss/2) If i<22 Then Shapes.Rotate( SHP[NMB][i], angle[NMB][i]+90-(angle[NMB][i]-angle[NMB][10])) Else Shapes.Rotate( SHP[NMB][i], angle[NMB][i]-(angle[NMB][i]-angle[NMB][22])) EndIf EndFor Program.Delay(40) EndFor endwhile Sub CenterPosition XYC[NMB]="X="+(shapes.GetLeft(shp[NMB][9])+dat[9]["wd"]*ss/2)+";Y="+ (shapes.Gettop(shp[NMB][9])+dat[9]["ht"]*ss/2) ' base point // For i= 10 To array.GetItemCount(dat) ddx=shapes.GetLeft(SHP[NMB][i])+dat[i]["wd"]*ss/2 - XYC[NMB]["X"] ddy=shapes.GetTop(SHP[NMB][i])+dat[i]["ht"]*ss/2 - XYC[NMB]["Y"] If ddX<=0 Then angle[NMB][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))-90 Else angle[NMB][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))+90 EndIf DR[NMB][i]=Math.SquareRoot((ddx)*(ddx)+(ddy)*(ddy)) endfor endsub Sub make_winmills wcc=ldtext.Split ("brown #999900 gold orange" " ") For NMB=1 To 3 ss=s[NMB] shx=sx[NMB] shy=sy[NMB] occ=wcc[nmb] wcl=wcc[nmb+1] add_shapes() CenterPosition() EndFor EndSub Sub add_shapes for i=1 To Array.GetItemCount(dat) dat[i]=LDText.Replace (dat[i] occ wcl) GraphicsWindow.BrushColor =dat[i]["bc"] GraphicsWindow.Penwidth = dat[i]["pw"] GraphicsWindow.penColor = dat[i]["pc"] If dat[i]["func"]="el" Then shp[NMB][i] = shapes.Addellipse(dat[i]["wd"]*ss,dat[i]["ht"]*ss) ElseIf dat[i]["func"]="rec" Then shp[NMB][i] = shapes.Addrectangle(dat[i]["wd"]*ss,dat[i]["ht"]*ss) ElseIf dat[i]["func"]="tri" Then shp[NMB][i] = shapes.Addtriangle(dat[i]["x1"]*ss,dat[i]["y1"]*ss,dat[i]["x2"]*ss,dat[i]["y2"]*ss,dat[i]["x3"]*ss,dat[i]["y3"]*ss) ElseIf dat[i]["func"]="ln" Then shp[NMB][i] = shapes.Addline(dat[i]["x1"]*ss,dat[i]["y1"]*ss,dat[i]["x2"]*ss,dat[i]["y2"]*ss) EndIf shapes.move(shp[NMB][i], dat[i]["x"]*ss+shX,dat[i]["y"]*ss+shY+dat[2]["ht"]*ss/5) shapes.Rotate(shp[NMB][i], dat[i]["angle"]) EndFor EndSub Sub windmill_shapes ' windmill s="1=0.25;2=0.4;3=0.8" sx="1=100;2=450;3=850" sy="1=280;2=230;3=180" dat[1]="func=rec;X=0;Y=100;wd=260;ht=340;angle=0;bc=#BBC8E6;pc=#A8C97F;pw=2" dat[2]="func=rec;X=0;Y=100;wd=120;ht=340;angle=0;bc=#9D896C;pc=#94846A;pw=1" dat[3]="func=rec;X=55;Y=160;wd=40;ht=24;angle=0;bc=#FFF1CF;pc=#333631;pw=2" dat[4]="func=rec;X=200;Y=160;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[5]="func=rec;X=190;Y=356;wd=40;ht=86;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[6]="func=el;X=190;Y=344;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=0" dat[7]="func=el;X=0;Y=76;wd=260;ht=44;angle=0;bc=darkred;pc=#1F3134;pw=0" dat[8]="func=tri;x1=0;y1=103;x2=124;y2=0;x3=260;y3=103;angle=0;bc=darkred;pc=#1F3134;pw=0" dat[9]="func=el;X=104;Y=46;wd=48;ht=48;angle=0;bc=blue;pc=black;pw=8" ' Wing -Up dat[10]="func=rec;X=126;Y=-154;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[11]="func=rec;X=134;Y=-154;wd=58;ht=178;angle=0;bc=brown;pc=#956F29;pw=2" dat[12]="func=rec;X=152;Y=-154;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[13]="func=rec;X=134;Y=-126;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[14]="func=rec;X=134;Y=-98;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[15]="func=rec;X=134;Y=-66;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Down dat[16]="func=rec;X=126;Y=90;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[17]="func=rec;X=68;Y=114;wd=58;ht=178;angle=0;bc=brown;pc=#956F29;pw=2" dat[18]="func=rec;X=86;Y=114;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[19]="func=rec;X=68;Y=142;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[20]="func=rec;X=68;Y=160;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[21]="func=rec;X=68;Y=192;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Right dat[22]="func=rec;X=148;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[23]="func=rec;X=174;Y=72;wd=178;ht=58;angle=0;bc=brown;pc=#956F29;pw=2" dat[24]="func=rec;X=174;Y=90;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[25]="func=rec;X=202;Y=72;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[26]="func=rec;X=230;Y=72;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[27]="func=rec;X=258;Y=72;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Left dat[28]="func=rec;X=-96;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[29]="func=rec;X=-96;Y=10;wd=178;ht=58;angle=0;bc=brown;pc=#956F29;pw=2" dat[30]="func=rec;X=-96;Y=28;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[31]="func=rec;X=-68;Y=10;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[32]="func=rec;X=-40;Y=10;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[33]="func=rec;X=-12;Y=10;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" EndSub End>QPB316-0.sb< Start>QPB316-2.sb< 'Challenge of the Month - April 2017 Windmill // by NaochanON QPB316-2 ' added 4 ducks GraphicsWindow.Width = 1200 GraphicsWindow.Height = 650 GraphicsWindow.Left=10 GraphicsWindow.top=10 GraphicsWindow.BackgroundColor="skyblue" GraphicsWindow.BrushColor="Darkgreen" GraphicsWindow.FillRectangle(0,400,1200,300) GraphicsWindow.BrushColor="Blue" GraphicsWindow.PenWidth=0 GraphicsWindow.FillTriangle(250,400,500,650,300,400) GraphicsWindow.FillTriangle(300,400,500,650,900,650) Duck_Init() dat=duck Name="Duck" s=ds sx=dsx sy=dsy add_shapes() windmill_init() s=ws sx=wsx sy=wsy Name="Windmill" add_shapes() While "True" For M=1 To Array.GetItemCount(ws) ' ' windmill SName=Name+"_"+M ss=ws[M] For i=10 to array.GetItemCount(dat) angle[Sname][i]=angle[Sname][i]-(3+(M-1)*2) _angle=math.GetRadians(angle[Sname][i]) Shapes.Move(SHP[Sname][i],XYC[Sname]["X"]+DR[Sname][i]*Math.Cos(_angle)-dat[i]["wd"]*ss/2,XYC[Sname]["Y"]+DR[Sname][i]*Math.sin(_angle)-dat[i]["ht"]*ss/2) If i<22 Then Shapes.Rotate( SHP[Sname][i], 90+angle[Sname][10]) Else Shapes.Rotate( SHP[Sname][i], angle[Sname][22]) EndIf EndFor Program.Delay(20) EndFor For j=1 To Array.GetItemCount(ds) ' duck Sname="Duck_"+j dx= Math.GetRandomNumber(10)/2 dy= -0.1 If Shapes.GetLeft(shp[SName][1])>590-20*J Then dx=-0.05 dY=0.3 endif If Shapes.Gettop(shp[SName][1])<460 then dx=Math.GetRandomNumber(10)/2 dY=-0.1 endif For k=1 To 10 Shapes.Move(shp[SName][k],Shapes.GetLeft(shp[SName][k])+dx,Shapes.Gettop(shp[SName][k])-dy) EndFor If Shapes.GetLeft(shp[SName][1])>1250 Then NMB=text.GetSubTextToEnd(Sname,6) For L=1 to 10 Shapes.Move(shp[SName][L], duck[L]["x"]*ds[NMB]+dsx[NMB]-200, duck[L]["y"]*ds[NMB]+dsy[NMB] ) endfor endif EndFor endwhile Sub CenterPosition if Text.IsSubText(Sname,"Windmill") Then XYC[Sname]="X="+(shapes.GetLeft(shp[Sname][9])+dat[9]["wd"]*ss/2)+";Y="+ (shapes.Gettop(shp[Sname][9])+dat[9]["ht"]*ss/2) ' base point // For i= 10 To array.GetItemCount(dat) ddx=shapes.GetLeft(SHP[Sname][i])+dat[i]["wd"]*ss/2 - XYC[Sname]["X"] ddy=shapes.GetTop(SHP[Sname][i])+dat[i]["ht"]*ss/2 - XYC[Sname]["Y"] If ddX<=0 Then angle[Sname][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))-90 Else angle[Sname][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))+90 EndIf DR[Sname][i]=Math.SquareRoot((ddx)*(ddx)+(ddy)*(ddy)) endfor endif endsub Sub add_shapes For M=1 To Array.GetItemCount(s) ss=s[M] shx=sX[M] shy=sY[M] SName=Name+"_"+M for i=1 To Array.GetItemCount(dat) GraphicsWindow.PenWidth = dat[i]["pw"] GraphicsWindow.BrushColor = dat[i]["bc"] GraphicsWindow.penColor = dat[i]["pc"] If dat[i]["func"]="el" Then shp[SName][i] = Shapes.AddEllipse(dat[i]["wd"]*ss, dat[i]["ht"]*ss) ElseIf dat[i]["func"]="rec" Then shp[SName][i] = Shapes.AddRectangle(dat[i]["wd"]*ss, dat[i]["ht"]*ss) ElseIf dat[i]["func"]="tri" Then shp[SName][i] = Shapes.Addtriangle(dat[i]["x1"]*ss, dat[i]["y1"]*ss,dat[i]["x2"]*ss, dat[i]["y2"]*ss, dat[i]["x3"]*ss, dat[i]["y3"]*ss) ElseIf dat[i]["func"]="ln" Then shp[SName][i] = Shapes.Addline(dat[i]["x1"]*ss, dat[i]["y1"]*ss,dat[i]["x2"]*ss, dat[i]["y2"]*ss) EndIf Shapes.Animate(shp[SName][i], dat[i]["x"]*ss+shx, dat[i]["y"]*ss+shy, 500) Shapes.Rotate(shp[SName][i], dat[i]["angle"]) EndFor CenterPosition() EndFor EndSub Sub windmill_init ws="1=0.25;2=0.4;3=0.9" wsx="1=100;2=450;3=850" wsy="1=300;2=250;3=180" dat[1]="func=rec;X=0;Y=100;wd=260;ht=340;angle=0;bc=#BBC8E6;pc=#A8C97F;pw=2" dat[2]="func=rec;X=0;Y=100;wd=120;ht=340;angle=0;bc=#9D896C;pc=#94846A;pw=1" dat[3]="func=rec;X=55;Y=160;wd=40;ht=24;angle=0;bc=#FFF1CF;pc=#333631;pw=2" dat[4]="func=rec;X=200;Y=160;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[5]="func=rec;X=190;Y=356;wd=40;ht=86;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[6]="func=el;X=190;Y=344;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=0" dat[7]="func=el;X=0;Y=76;wd=260;ht=44;angle=0;bc=#1F3134;pc=#1F3134;pw=0" dat[8]="func=tri;x1=0;y1=103;x2=124;y2=0;x3=260;y3=103;angle=0;bc=#1F3134;pc=#1F3134;pw=0" dat[9]="func=el;X=108;Y=50;wd=40;ht=40;angle=0;bc=#3EB370;pc=#005243;pw=2" ' Wing -Up dat[10]="func=rec;X=126;Y=-154;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[11]="func=rec;X=134;Y=-154;wd=58;ht=178;angle=0;bc=#F8E58C;pc=#956F29;pw=2" dat[12]="func=rec;X=152;Y=-154;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[13]="func=rec;X=134;Y=-126;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[14]="func=rec;X=134;Y=-98;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[15]="func=rec;X=134;Y=-66;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Down dat[16]="func=rec;X=126;Y=90;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[17]="func=rec;X=68;Y=114;wd=58;ht=178;angle=0;bc=#F8E58C;pc=#956F29;pw=2" dat[18]="func=rec;X=86;Y=114;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[19]="func=rec;X=68;Y=142;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[20]="func=rec;X=68;Y=160;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[21]="func=rec;X=68;Y=192;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Right dat[22]="func=rec;X=148;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[23]="func=rec;X=174;Y=72;wd=178;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[24]="func=rec;X=174;Y=90;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[25]="func=rec;X=202;Y=72;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[26]="func=rec;X=230;Y=72;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[27]="func=rec;X=258;Y=72;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Left dat[28]="func=rec;X=-96;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[29]="func=rec;X=-96;Y=10;wd=178;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[30]="func=rec;X=-96;Y=28;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[31]="func=rec;X=-68;Y=10;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[32]="func=rec;X=-40;Y=10;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[33]="func=rec;X=-12;Y=10;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" EndSub Sub Duck_Init ' Duck ds ="1=0.13;2=0.25;3=0.2;4=0.3" dsX ="1=98;2=84;3=75;4=65" dsY ="1=520;2=560;3=530;4=580" duck[1] = "func=tri;x=153;y=41;x1=47;y1=0;x2=0;y2=22;x3=95;y3=22;bc=red;pw=0" ';beck" duck[2] = "func=el;x=118;y=0;wd=91;ht=73;bc=#460E44;pw=0;" ' Head duck[3] = "func=ln;x=172;y=36;x1=0;y1=0;x2=22;y2=0;pc=red;pw=2" ' ;blink" duck[4] = "func=el;x=172;y=25;wd=22;ht=22;bc=pink;pw=0" ' ;eye" duck[5] = "func=tri;x=132;y=58;x1=31;y1=0;x2=0;y2=45;x3=62;y3=45;bc=red;pw=0" ' ;neck" duck[6] = "func=tri;x=0;y=80;x1=37;y1=0;x2=0;y2=32;x3=75;y3=32;angle=178;bc=red;pw=0" ' ;tail" duck[7] = "func=ln;x=91;y=134;x1=0;y1=0;x2=0;y2=36;pc=red;pw=8" ' ;Leg1" duck[8] = "func=el;x=33;y=72;wd=164;ht=82;bc=#00A497;pw=0" ' ;body" duck[9] = "func=tri;x=58;y=180;x1=46;y1=0;x2=0;y2=14;x3=93;y3=14;bc=red;pw=0" ';Leg3" duck[10] = "func=ln;x=90;y=169;x1=0;y1=0;x2=14;y2=15;pc=yellow;pw=8" ' ;Leg2" EndSub End>QPB316-2.sb< Start>QPB316.sb< 'Challenge of the Month - April 2017 Windmill // by NaochanON GraphicsWindow.Width = 1200 GraphicsWindow.Height = 600 GraphicsWindow.Left=10 GraphicsWindow.top=10 GraphicsWindow.BackgroundColor="skyblue" GraphicsWindow.BrushColor="Darkgreen" GraphicsWindow.FillRectangle(0,400,1200,300) GraphicsWindow.BrushColor="Blue" GraphicsWindow.PenWidth=0 GraphicsWindow.FillTriangle(250,400,500,600,300,400) GraphicsWindow.FillTriangle(300,400,500,600,800,600) windmill_shapes() make_winmills() While "True" For NMB=1 To 3 ss=s[NMB] For i=10 to array.GetItemCount(dat) angle[NMB][i]=angle[NMB][i]-10 _angle=math.GetRadians(angle[NMB][i]) Shapes.Move(SHP[NMB][i],XYC[NMB]["X"]+DR[NMB][i]*Math.Cos(_angle)-dat[i]["wd"]*ss/2,XYC[NMB]["Y"]+DR[NMB][i]*Math.sin(_angle)-dat[i]["ht"]*ss/2) If i<22 Then Shapes.Rotate( SHP[NMB][i], angle[NMB][i]+90-(angle[NMB][i]-angle[NMB][10])) Else Shapes.Rotate( SHP[NMB][i], angle[NMB][i]-(angle[NMB][i]-angle[NMB][22])) EndIf EndFor Program.Delay(40) EndFor endwhile Sub CenterPosition XYC[NMB]="X="+(shapes.GetLeft(shp[NMB][9])+dat[9]["wd"]*ss/2)+";Y="+ (shapes.Gettop(shp[NMB][9])+dat[9]["ht"]*ss/2) ' base point // For i= 10 To array.GetItemCount(dat) ddx=shapes.GetLeft(SHP[NMB][i])+dat[i]["wd"]*ss/2 - XYC[NMB]["X"] ddy=shapes.GetTop(SHP[NMB][i])+dat[i]["ht"]*ss/2 - XYC[NMB]["Y"] If ddX<=0 Then angle[NMB][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))-90 Else angle[NMB][i]=Math.GetDegrees(Math.ArcTan((ddY)/(ddX+0.0000000001)))+90 EndIf DR[NMB][i]=Math.SquareRoot((ddx)*(ddx)+(ddy)*(ddy)) endfor endsub Sub make_winmills For NMB=1 To 3 ss=s[NMB] shx=sx[NMB] shy=sy[NMB] add_shapes() CenterPosition() EndFor EndSub Sub add_shapes for i=1 To Array.GetItemCount(dat) GraphicsWindow.BrushColor =dat[i]["bc"] GraphicsWindow.Penwidth = dat[i]["pw"] GraphicsWindow.penColor = dat[i]["pc"] If dat[i]["func"]="el" Then shp[NMB][i] = shapes.Addellipse(dat[i]["wd"]*ss,dat[i]["ht"]*ss) ElseIf dat[i]["func"]="rec" Then shp[NMB][i] = shapes.Addrectangle(dat[i]["wd"]*ss,dat[i]["ht"]*ss) ElseIf dat[i]["func"]="tri" Then shp[NMB][i] = shapes.Addtriangle(dat[i]["x1"]*ss,dat[i]["y1"]*ss,dat[i]["x2"]*ss,dat[i]["y2"]*ss,dat[i]["x3"]*ss,dat[i]["y3"]*ss) ElseIf dat[i]["func"]="ln" Then shp[NMB][i] = shapes.Addline(dat[i]["x1"]*ss,dat[i]["y1"]*ss,dat[i]["x2"]*ss,dat[i]["y2"]*ss) EndIf shapes.move(shp[NMB][i], dat[i]["x"]*ss+shX,dat[i]["y"]*ss+shY+dat[2]["ht"]*ss/5) shapes.Rotate(shp[NMB][i], dat[i]["angle"]) EndFor EndSub Sub windmill_shapes ' windmill s="1=0.25;2=0.4;3=0.8" sx="1=100;2=450;3=850" sy="1=280;2=230;3=180" dat[1]="func=rec;X=0;Y=100;wd=260;ht=340;angle=0;bc=#BBC8E6;pc=#A8C97F;pw=2" dat[2]="func=rec;X=0;Y=100;wd=120;ht=340;angle=0;bc=#9D896C;pc=#94846A;pw=1" dat[3]="func=rec;X=55;Y=160;wd=40;ht=24;angle=0;bc=#FFF1CF;pc=#333631;pw=2" dat[4]="func=rec;X=200;Y=160;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[5]="func=rec;X=190;Y=356;wd=40;ht=86;angle=0;bc=#5B6356;pc=#716246;pw=2" dat[6]="func=el;X=190;Y=344;wd=40;ht=24;angle=0;bc=#5B6356;pc=#716246;pw=0" dat[7]="func=el;X=0;Y=76;wd=260;ht=44;angle=0;bc=#1F3134;pc=#1F3134;pw=0" dat[8]="func=tri;x1=0;y1=103;x2=124;y2=0;x3=260;y3=103;angle=0;bc=#1F3134;pc=#1F3134;pw=0" dat[9]="func=el;X=108;Y=50;wd=40;ht=40;angle=0;bc=#3EB370;pc=#005243;pw=2" ' Wing -Up dat[10]="func=rec;X=126;Y=-154;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[11]="func=rec;X=134;Y=-154;wd=58;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[12]="func=rec;X=152;Y=-154;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[13]="func=rec;X=134;Y=-126;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[14]="func=rec;X=134;Y=-98;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[15]="func=rec;X=134;Y=-66;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Down dat[16]="func=rec;X=126;Y=90;wd=12;ht=204;angle=0;bc=#302833;pc=#302833;pw=0" dat[17]="func=rec;X=68;Y=114;wd=58;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[18]="func=rec;X=86;Y=114;wd=20;ht=178;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[19]="func=rec;X=68;Y=142;wd=58;ht=124;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[20]="func=rec;X=68;Y=160;wd=58;ht=62;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[21]="func=rec;X=68;Y=192;wd=58;ht=4;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Right dat[22]="func=rec;X=148;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[23]="func=rec;X=174;Y=72;wd=178;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[24]="func=rec;X=174;Y=90;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[25]="func=rec;X=202;Y=72;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[26]="func=rec;X=230;Y=72;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[27]="func=rec;X=258;Y=72;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" ' Wing -Left dat[28]="func=rec;X=-96;Y=64;wd=204;ht=12;angle=0;bc=#302833;pc=#302833;pw=0" dat[29]="func=rec;X=-96;Y=10;wd=178;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[30]="func=rec;X=-96;Y=28;wd=178;ht=20;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[31]="func=rec;X=-68;Y=10;wd=124;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[32]="func=rec;X=-40;Y=10;wd=62;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" dat[33]="func=rec;X=-12;Y=10;wd=4;ht=58;angle=0;bc=Transparent;pc=#956F29;pw=2" EndSub End>QPB316.sb< Start>QPB413.sb< a=math.ArcSin (47/53)+math.pi/2 b=ldmath.ArcSin (56/64*180/Math.pi) c=Math.Pi/4 GraphicsWindow.BackgroundColor="teal GraphicsWindow.Height =700 GraphicsWindow.Width =900 GraphicsWindow.Left =10 GraphicsWindow.Top=10 GraphicsWindow.Title ="Batsign q=3*math.SquareRoot (2)/5 tt="@t)/t*(0.3*@t) +0.2*@@t)-1) +2.2*@@t)-2) -2.7*@@t)-3) -3*@@t)-5) +3*@@t)-7) +5*$(c*(@@t)-3)-@@t)-4)+1))+5/4*^(@@t)-4)-@@t)-5)-1,3)-5.3*#(a/2*(@@t)-7)-@@t)-8)-1))+2.8)" tt1="1.5*@@t)-1)-1.5*@@t)-2)-29/4*@@t)-4)+29/4*@@t)-5)+7/16*^(@@t)-2)-@@t)-3)-1,4)+4.5*$(c*(@@t)-3)-@@t)-4)-1))-q*^(@@@t)-5)-@@t)-7)),2.5)+6.4*$(a/2*(@@t)-7)-@@t)-8)+1)+b)+4.95 For qq=0 To 20 Step 1.5 GraphicsWindow.PenColor =LDColours.HSLtoRGB (0 0 qq/20) For t=-9 To 9 Step .1 ee=ldtext.Replace(ldtext.Replace(ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace(ldtext.Replace(tt "a" a) "t" t) "c" c) "p" "3.1415926535") "$" "Math.Sin") "@" "Math.Abs(") "^" "Math.Pow") "#" "Math.Cos") ey=ldtext.Replace(ldtext.Replace(ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace (ldtext.Replace(tt1 "a" a) "b" b) "t" t) "c" c) "q" q) "$" "Math.Sin") "p" "3.1415926535") "@" "Math.Abs(") "^" "Math.Pow") "c" "Math.Cos") nx=400+qq/2+ldmath.Evaluate (ee)*(15-qq/3) ny=400-qq-ldmath.Evaluate (ey)*(15-qq/3) If t>-9 then GraphicsWindow.drawline(ox oy nx ny) endif ox=nx oy=ny EndFor EndFor End>QPB413.sb< Start>QPC665.sb< ' mahreen miangul ' ApRiL 2019 GraphicsWindow.Width = 1080 GraphicsWindow.Height = 420 GraphicsWindow.backgroundColor = "darkkhaki 'GraphicsWindow.BrushColor = GraphicsWindow.GetRandomColor() GraphicsWindow.penwidth = 4 GraphicsWindow.PenColor = "black GraphicsWindow.BrushColor = "DarkOliveGreen haroon1 = shapes.addtriangle(100, 40, 150, -40, 200, 40) Shapes.move(haroon1, 0, 120) Shapes.animate(haroon1,700, 120, 2000) Shapes.Zoom(haroon1, 1.8, 1.5) GraphicsWindow.penwidth = 2 GraphicsWindow.BrushColor = "white haroon1 = shapes.addellipse(15, 20) Shapes.move(haroon1, 0, 120) Shapes.animate(haroon1,860, 100, 2000) Shapes.Zoom(haroon1, 1.8, 1.5) haroon1 = shapes.addellipse(15, 20) Shapes.move(haroon1, 0, 120) Shapes.animate(haroon1,900, 100, 2000) Shapes.Zoom(haroon1, 1.8, 1.5) GraphicsWindow.fontsize = 14 haroon1 = shapes.addtext("❗") Shapes.move(haroon1, 0, 120) Shapes.Zoom(haroon1, 1.8, 1.5) Shapes.animate(haroon1,885, 110, 2000) GraphicsWindow.fontsize = 14 haroon1 = shapes.addtext("✔") Shapes.move(haroon1, 0, 120) Shapes.animate(haroon1,885, 135, 2000) 'Shapes.rotate(haroon1, 0) Shapes.Zoom(haroon1, 1.8, 1.5) 'Shapes.SetOpacity(haroon1, 50) ' add eyelids GraphicsWindow.PenColor = "transparent GraphicsWindow.BrushColor = "DarkOliveGreen For i = 1 To 2 eyelids[i] = Shapes.AddEllipse(24, 30) Shapes.move(eyelids[i], 0, 0) Shapes.animate(eyelids[i], 855 + (i - 1) * 40, 93, 2000) EndFor Timer.Tick = Blink Timer.Interval = 500 Sub Blink t = t + 1 If Math.Remainder(t, 6) = 1 Then For i = 1 To 2 Shapes.HideShape(eyelids[i]) EndFor ElseIf Math.Remainder(t, 6) = 0 Then For i = 1 To 2 Shapes.ShowShape(eyelids[i]) EndFor EndIf EndSub End>QPC665.sb< Start>QPC753.sb< ' Animation Stick Figures 'mahreen miangul ' JuNe 2018 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Width = "1280" GraphicsWindow.Height = "720" GraphicsWindow.BackgroundColor = "LightYellow" GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 120 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "Silver" ' Text shadow color GraphicsWindow.DrawText(5, 5, "mahreen miangul!") ' Shadow position/text GraphicsWindow.BrushColor = "RosyBrown" ' Text color GraphicsWindow.DrawText(0, 0, "mahreen miangul!") ' Position and text MakeSprite() ddx=-5 ddy=0 While "True" For i=1 To 30 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+ddx,shapes.GetTop(ell[i])+ddy) 'Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+ddx,shapes.GetTop(rec[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+ddx,shapes.GetTop(line[i])+ddy) EndFor If Shapes.GetLeft(ell[1])<-200 Then moveright() EndIf Program.Delay(20) endwhile Sub moveright el1y=shapes.GetTop(ell[1]) ddy= Math.GetRandomNumber(Math.Abs(300-el1y))-el1y For i=1 To 30 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+1200,shapes.GetTop(ell[i])+ddy) 'Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+1200,shapes.GetTop(rec[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+1200,shapes.GetTop(line[i])+ddy) EndFor ddy=0 EndSub Sub MakeSprite ' 1 Ellipses 1 GraphicsWindow.penColor="green GraphicsWindow.brushColor="green ell[1] = Shapes.addEllipse(50,50) Shapes.Move(ell[1], 315,150) GraphicsWindow.penColor="orange GraphicsWindow.brushColor="orange ell[2] = Shapes.addEllipse(50,50) Shapes.Move(ell[2], 415,150) GraphicsWindow.penColor="blue GraphicsWindow.brushColor="blue ell[3] = Shapes.addEllipse(50,50) Shapes.Move(ell[3], 515,150) GraphicsWindow.penColor="red GraphicsWindow.brushColor="red ell[4] = Shapes.addEllipse(50,50) Shapes.Move(ell[4], 615,150) ' 10 Lines GraphicsWindow.penwidth = 12 GraphicsWindow.penColor = "green line[1] = Shapes.Addline(340, 200, 340, 260) '<-- body Shapes.Move(line[1], 0,0) line[2] = Shapes.Addline(340, 205, 310, 240) '<-- Shoulder 1 Shapes.Move(line[2], 0,0) line[3] = Shapes.Addline(313, 235, 295, 280) '<-- arm 1 Shapes.Move(line[3], 0,0) line[4] = Shapes.Addline(340, 205, 370, 240) '<-- Shoulder 2 Shapes.Move(line[4], 0,0) line[5] = Shapes.Addline(368, 235, 390, 270) '<-- arm 2 Shapes.Move(line[5], 0,0) line[6] = Shapes.Addline(340, 260, 300, 350) Shapes.Move(line[6], 0,0) line[7] = Shapes.Addline(340, 260, 380, 350) Shapes.Move(line[7], 0,0) GraphicsWindow.penColor = "orange line[8] = Shapes.Addline(440, 200, 440, 260) '<-- body Shapes.Move(line[8], 0,0) line[9] = Shapes.Addline(440, 200, 410, 245) Shapes.Move(line[9], 0,0) line[10] = Shapes.Addline(415, 235, 400, 270) '<-- arm 1 Shapes.Move(line[10], 0,0) line[11] = Shapes.Addline(440, 205, 477, 240) Shapes.Move(line[11], 0,0) line[12] = Shapes.Addline(470, 230, 490, 262) '<-- arm 2 Shapes.Move(line[12], 0,0) line[13] = Shapes.Addline(440, 260, 415, 350) Shapes.Move(line[13], 0,0) line[14] = Shapes.Addline(440, 260, 480, 350) Shapes.Move(line[14], 0,0) GraphicsWindow.penColor = "blue line[15] = Shapes.Addline(540, 200, 540, 260) '<-- body Shapes.Move(line[15], 0,0) line[16] = Shapes.Addline(540, 205, 510, 240) '<-- Shoulder 1 Shapes.Move(line[16], 0,0) line[17] = Shapes.Addline(513, 235, 490, 265) '<-- arm 1 Shapes.Move(line[17], 0,0) line[18] = Shapes.Addline(540, 205, 570, 240) '<-- Shoulder 2 Shapes.Move(line[18], 0,0) line[19] = Shapes.Addline(570, 245, 590, 200) '<-- arm 2 Shapes.Move(line[19], 0,0) line[20] = Shapes.Addline(540, 260, 500, 350) Shapes.Move(line[20], 0,0) line[21] = Shapes.Addline(540, 260, 580, 350) Shapes.Move(line[21], 0,0) GraphicsWindow.penColor = "red line[22] = Shapes.Addline(640, 200, 640, 260) '<-- body Shapes.Move(line[22], 0,0) line[23] = Shapes.Addline(640, 205, 600, 240) Shapes.Move(line[23], 0,0) line[24] = Shapes.Addline(590, 200, 605, 240) '<-- arm 1 Shapes.Move(line[24], 0,0) line[25] = Shapes.Addline(640, 205, 666, 240) Shapes.Move(line[25], 0,0) line[26] = Shapes.Addline(660, 230, 677, 266) '<-- arm 2 Shapes.Move(line[26], 0,0) line[27] = Shapes.Addline(640, 260, 600, 350) Shapes.Move(line[27], 0,0) line[28] = Shapes.Addline(640, 260, 680, 350) Shapes.Move(line[28], 0,0) EndSub End>QPC753.sb< Start>QPF671.sb< GraphicsWindow.BackgroundColor="darkblue" cx=624/2 cy=442/2 GraphicsWindow.Title ="Jellyfish GraphicsWindow.PenWidth = 0 LDPhysics.SetGravity(0,0) While "true a=0 vv=10 For n=1 To 160 vv=vv*0.98 r15=math.SquareRoot(n)/2+4 x=cx+ldmath.Sin(a)*(cy-10) y=cy+ldmath.Cos(a)*(cy-10) dx=ldmath.Sin(a) dy=ldmath.Cos(a) GraphicsWindow.BrushColor=LDColours.HSLtoRGB (n/2 1 .6) t[n] = Shapes.AddEllipse(r15,r15) LDPhysics.AddMovingShape(t[n],1,0,0) LDPhysics.SetPosition(t[n],x,y,0) LDPhysics.SetVelocity(t[n],-dx*vv, -dy*vv)'-dx*50,-dy*50) a=a+137.5 LDPhysics.DoTimestep() EndFor a=0 For r=1 To 2400 LDPhysics.DoTimestep() 'Program.Delay (1) EndFor For r=1 To 160 LDPhysics.RemoveShape (t[r]) endfor endwhile End>QPF671.sb< Start>QPG365.sb< GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp 'Simplified dummy setup for images walking left and right - this is just to see something - a game would use images for each player etc player1X = 50 'Initial X (Left of player) player1Y = GraphicsWindow.Height - 60 'Initial Y (Top of player) dir = Program.Directory+"\sidestroller\" For i = 1 To 3 player1WalkLeft[i] = Shapes.AddImage(ImageList.LoadImage(dir+"walkL"+i+".png")) Shapes.HideShape(player1WalkLeft[i]) player1WalkRight[i] = Shapes.AddImage(ImageList.LoadImage(dir+"walkR"+i+".png")) Shapes.HideShape(player1WalkRight[i]) EndFor 'Show initial player player1Frame = 1 'First frame player1 = player1WalkRight[player1Frame] Shapes.Move(player1,player1X,player1Y) Shapes.ShowShape(player1) 'Main Loop While("True") start = Clock.ElapsedMilliseconds movePlayers() delay = 25 - (Clock.ElapsedMilliseconds-start) 'Max delay of 25ms is 40 fps If (delay > 0) Then Program.Delay(delay) EndIf EndWhile 'Move players 'player1 is the current active shown image (there is only ever one not hidden at a time) Sub movePlayers If (keyDown["Left"]) Then player1X = player1X-2 'Move player position left If (Math.Remainder(iFrame,8) = 0) Then 'Update player every 8 frames of movement Shapes.HideShape(player1) 'Hide current player image (will be last player image) player1Frame = 1+Math.Remainder(player1Frame,3) 'Cycle player image in group (these for walking left) player1 = player1WalkLeft[player1Frame] 'The next player image in group is now the current player image Shapes.Move(player1,player1X,player1Y) 'Move the image before we show it Shapes.ShowShape(player1) 'Show current player image Else Shapes.Move(player1,player1X,player1Y) 'Just move player EndIf iFrame = iFrame+1 ElseIf (keyDown["Right"]) Then player1X = player1X+2 If (Math.Remainder(iFrame,8) = 0) Then Shapes.HideShape(player1) player1Frame = 1+Math.Remainder(player1Frame,3) player1 = player1WalkRight[player1Frame] Shapes.Move(player1,player1X,player1Y) 'Move the image before we show it Shapes.ShowShape(player1) 'Show current player image Else Shapes.Move(player1,player1X,player1Y) EndIf iFrame = iFrame+1 Else iFrame = 0 EndIf EndSub 'Register events Sub OnKeyDown key = GraphicsWindow.LastKey keyDown[key] = "True" EndSub Sub OnKeyUp key = GraphicsWindow.LastKey keyDown[key] = "" EndSub End>QPG365.sb< Start>QPJ207.sb< dbg="False" LDDialogs.Wait("Turtle commander V1.1"+ESLText.CRLF +"(p)2015 by SB community","Green") Program.Delay(1500) LDDialogs.EndWait () dmt="0=Add/Chng...;1=Diamond;2=MultiDiamnds;3=Lace;4=Spyrall;5=Star5;6=HyperLoop;7=HypFlwrGrid;8=Flwr5;9=Flwr4;10=Clock dmm=11 vcnt=0 scnt=0 smd=0 deff[1]="{10!S 0!R 108!{5 !R 72!F 80!}!## deff[2]="{5!S 0!{10!R 108!{5 !R 72!F 80!}!}!R 144!U!F 210!D!## deff[3]="{25!S 0!F 30!{3 !R 95!F 140!}!## deff[4]="{95!S 1.025!R 91.5!F 40!## deff[5]="{5!R 144!F 140!## deff[6]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!$!R 90!{55 !R 91.5!F 40!S/1.025!}!&!L 90!{55 !R 91.5!F 40!S/1.025!}!&!R 90!{55 !L 91.5!F 40!S/1.025!}!## deff[7]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!$!R 90!{55 !R 91.5!F 40!S/1.025!}!&!L 90!{55 !R 91.5!F 40!S/1.025!}!&!R 90!{55 !L 91.5!F 40!S/1.025!}!&!{55 !L 91.5!F 40!S/1.025!}!&!{55 !R 91.5!F 40!S/1.025!}!&!R 180!{55 !R 91.5!F 40!S/1.025!}!&!R 180!{55 !L 91.5!F 40!S/1.025!}!## deff[8]="{5!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.93!}!## deff[9]="{4!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.76!}!## deff[10]="{1!D!R 130!{72 !F 11!R 5!}!|V2=1!U!R 140!F 33!L 136!{12 !WRT %1!F 55!R 30!|V2+1!}!R 72!F 20!D!F 100!R 45!F 60!## _TFL="0=False;1=True;2=True" stpp=0 Init() LDDialogs.AddRightClickMenu(dmt,"") LDDialogs.RightClickMenu=rmm return=0 args=0 GraphicsWindow.MouseDown=mdd GraphicsWindow.MouseMove=mww GraphicsWindow.MouseUp=muu Main() Sub domsg LDDialogs.Wait("Turtle commander V1.1"+ESLText.CRLF +"(p)2015 by SB community","Green") Program.Delay(1500) LDDialogs.EndWait () EndSub Sub muu nxt=1 endsub Sub cang ox= Turtle.X oy= Turtle.Y nx= GraphicsWindow. Mousex ny= GraphicsWindow. Mousey ta= Turtle.Angle aag= mathplus.GetDegrees ( MathPlus.ATan2(nx-ox,ny-oy)+Math.Pi/2) -ta If aag>180 Then aag=aag-360 elseIf aa<-180 Then aag=aag+360 endif aag=math.Round(aag) endsub Sub mww If rec=1 Then cang() GraphicsWindow.Title = aag+" | old:"+Turtle.angle endif EndSub Sub mdd If mov=1 Then Turtle.x= GraphicsWindow.MouseX Turtle.y=GraphicsWindow.MouseY mov=0 elseif rec=1 and nxt=1 Then nxt=0 'cang() ota=turtle.angle Turtle.Angle=Turtle.Angle+aag If Turtle.Angle>180 then Turtle.Angle=Turtle.Angle-360 elseif Turtle.Angle<-180 then Turtle.Angle=Turtle.Angle+360 endif nta=turtle.angle dta=nta-ota dst= Math.SquareRoot ( ESLMaths.Square (GraphicsWindow.MouseX - Turtle.x)+ESLMaths.Square (GraphicsWindow.Mousey - Turtle.y)) dst=math.Round (dst) Turtle.Move (dst) dd="R " If dta<0 then dd="L " endif 'TextWindow.WriteLine (aag) Clipboard.SetText(cr+dd+Math.Abs(dta)+cr+"F "+dst) LDFocus.SetFocus(pgm) aw = SPExtra.SendKeys("+{INS}") EndIf EndSub Sub findvar ar=Text.ConvertToUpperCase(args[1]) For ax=1 To vcnt If Text.ConvertToUpperCase(mem[ax][0])=ar Then return=ax Goto xxx endif EndFor TextWindow.WriteLine (ar+" VAR-notfnd!") return="!VARnotfnd!" xxx: endsub Sub rmm dd= LDDialogs.LastRightClickMenuItem if dd>0 Then LDControls .RichTextBoxSetText(pgm, LDText.Replace ( deff[dd],"!",ESLText.CRLF ),"False") Else ib=Dialogs.AskForTextLine ("Name (x=exit, l=load, s=save):","New Menu Item") If ib="s" Then ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("i:\defs.txt",deff) ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("i:\defm.txt",dmt) LDCall.Function ("DoMsg","Saved ok.") elseIf ib="l" Then ' The following line could be harmful and has been automatically commented. ' deff=File.ReadContents ("i:\defs.txt") ' The following line could be harmful and has been automatically commented. ' dmt=File.ReadContents ("i:\defm.txt") LDCall.Function ("DoMsg","Load ok.") LDDialogs.AddRightClickMenu(dmt,"") elseIf ib<>"x" then li= LDText.Split (src,CR) att="" For t=1 To Array.GetItemCount (li) att=att+li[t]+"!" endfor deff[dmm]= att dmt[dmm]=ib dmm=dmm+1 LDDialogs.AddRightClickMenu(dmt,"") endif EndIf EndSub Sub hshow txx= LDText.Split("FWD!BCK!<<>>!LOOP!VAR!CNST!SUB!FOR!GRID!Rec!MvTo!IF!EDIT!OPEN!NEW","!") For x=1 To 16 bb[x]= Controls.AddButton(txx[x], 2, 5+(x-1)*40) EndFor EndSub Sub Main nwwp: nww=0 tree="" tree[1][0]="Main" tree[2][1]="Defs tree[3][2]="Heading tree[4][3]="0 tree[5][2]="Bgrnd tree[6][5]="#bbccdd tree[7][2]="ForeClr tree[8][7]="AUTO tree[9][2]="Width tree[10][9]="4 tree[11][1]="Consts tree[12][1]="Vars tree[13][1]="Subs/Lps mem=0 sbb=0 Goto rr2 rrr: GraphicsWindow.BackgroundColor =bcll rr2: nxt=1 _inn=0 GraphicsWindow.Clear() Turtle.Show() GraphicsWindow.PenWidth=4 Turtle.PenUp () Turtle.MoveTo (600,400) Turtle.PenDown () GraphicsWindow.FontName="Calibri" GraphicsWindow.FontSize=14 hshow() ch=0 _l=1 sc=1 _sbc=0 GraphicsWindow.BrushColor = "DimGray" LDControls.RichTextBoxFontFamily="Lucida Console" LDControls .RichTextBoxFontSize = 18 trr=LDControls.AddTreeView(tree,180,350) nset() Controls.Move (trr,50,gh-355) pgm = ldControls.AddRichTextBox (10, 10) Controls.SetSize(pgm, 180, gh - 360) Controls.Move (pgm,50,1) ldControls.RichTextBoxSetText (pgm, src,"False") LDControls.RichTextBoxDefault(pgm) GraphicsWindow.BrushColor = "Black" g=gh-36 c1= Controls.AddButton("RUN", 2, g) g=g-35 c2=Controls.AddButton("CLR", 2, g) g=g-35 c3=Controls.AddButton("XPlain", 2, g) g=g-35 c4=Controls.AddButton("Paste", 2, g) g=g-35 c5=Controls.AddButton("? hlp", 2, g) g=g-35 c6=Controls.AddButton("TrcCh", 2, g) clicked = "False" Controls.ButtonClicked = OnButtonClicked GraphicsWindow.PenColor = "DimGray" Turtle.Show() Turtle.PenUp() Turtle.MoveTo (700,400) Turtle.PenDown() Turtle.Angle=0 GraphicsWindow.FontName = "Lucida Console" GraphicsWindow.FontSize =12 While "True" If rst=1 Then src = LDControls .RichTextBoxGetText (pgm) tree=LDControls.TreeViewGetData(trr) bcll =tree[6][5] rst=0 If nww=1 then Goto nwwp else Goto rrr endif elseIf clicked Then Controls.SetButtonCaption(c1,"STOP") clicked = "False" src = LDControls .RichTextBoxGetText(pgm) If Text.GetSubText(src,1,1)="{" or Text.GetSubText(src,1,1)="#" then If Text.GetSubText(src,1,1)="#" then dbg="True" Else dbg="False" endif line= LDText.Split (src,ESLText.CRLF ) rrw=MathPlus.ToNumber ( text.GetSubTextToEnd(line[1],2)) nLines =Array.GetItemCount (line) If dbg then TextWindow.WriteLine (">>>>>>>>>>>>>>>>>>>>>runn>>>>>>>>>>>>>>>>>>") endif GraphicsWindow.Title="Run mode..." tree=LDControls.TreeViewGetData(trr) 'TextWindow.WriteLine(tree) GraphicsWindow.PenWidth=tree[10][9] 'GraphicsWindow.Title=rrw tree=LDControls.TreeViewGetData(trr) Turtle.Angle =tree[4][3] sbscan() For tt=1 To rrw vcnt=0 scnt=0 'TextWindow.WriteLine (line) For i = 2 To rwx linee=line[i] If Text.StartsWith(linee,"##") then Goto finn elseif Text.StartsWith(linee,"<") then smd=1 elseif Text.StartsWith(linee,">") then smd=0 ElseIf smd=0 and stpp=0 then DoLine() endif If stpp=1 then Controls.SetButtonCaption(c1,"RUN") stpp=0 GraphicsWindow.Title="Stopped." clicked="False Goto wwh endif EndFor finn: EndFor tree[4][3]=math.Round (math.Remainder (Turtle.Angle,360)) LDControls.TreeViewContent(trr,tree) nset() Controls.SetButtonCaption(c1,"RUN") GraphicsWindow.Title="Done." EndIf Else EndIf wwh: EndWhile EndSub Sub sbscan c=1 rwx=nLines While Text.StartsWith (line[c],"##")<>"True c=c+1 If c>nLines then TextWindow.WriteLine("No ##") goto tt endif EndWhile rwx=c-1 For i=c To nLines If Text.StartsWith(line[i], "<") Then _sbc=_sbc+1 smd=1 sbb[_sbc]["Stt"] = i + 1 For k = i+1 To nLines If Text.StartsWith(line[k], ">") Then sbb[_sbc]["End"] = k-1 smd=0 endif endfor tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 If dbg then typ="Sb" sbb[_sbc][0]=Text.GetSubTextToEnd (linee, 2) tree[nc][13]=typ+":"+_sbc+">"+sbb[_sbc]["Stt"]+" to "+sbb[_sbc]["End"] LDControls.TreeViewContent(trr,tree) nset() endif endif endfor tt: Endsub Sub nset LDControls.TreeViewExpand(trr,0,"True","True") nn= LDText.Split("4,6,8,10",",") For x=1 To Array.GetItemCount(nn) LDControls.TreeViewEdit(trr,nn[x],"True") endfor EndSub Sub drwgrd GraphicsWindow.PenWidth=1 GraphicsWindow.PenColor="#aaaaaa For x=1 To 70 GraphicsWindow.DrawLine(220+x*20,0,220+x*20,800) EndFor For x=1 To 40 GraphicsWindow.DrawLine(220,x*20,1400,x*20) EndFor EndSub Sub xplain TextWindow.Show () TextWindow.Clear() idd=" " src = LDControls .RichTextBoxGetText (pgm) TextWindow.WriteLine("Explain program dump list"+ESLText.CRLF ) line= LDText.Split (Text.ConvertToUpperCase(src),ESLText.CRLF ) rrw=MathPlus.ToNumber ( text.GetSubTextToEnd(line[1],2)) nLines =Array.GetItemCount (line) TextWindow.WriteLine ("{Main loop, repeating times:"+rrw) For i=2 To nLines linee=line[i] If Text.StartsWith(linee,"##") then TextWindow.WriteLine ("} Main loop end.*******************") else xpline() endif EndFor endsub Sub OnButtonClicked '"FWD!BCK!<<>>!LOOP!VAR!CNST!sub!FOR!SUB!SAVE!LOAD!IF!HLP!NEW" clb=Controls.LastClickedButton If clb=c2 then rst=1 elseIf clb=c3 then xplain () elseIf clb=c4 then LDControls.RichTextBoxClear (pgm) LDFocus.SetFocus(pgm) aa = SPExtra.SendKeys("+{INS}") rst=1 elseif clb=bb[1] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"F ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[2] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"R 180"+cr+"F "+cr+"R 180") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[3] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"L ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[4] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"R ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[5] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"{1 [") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[6] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"|v1=1") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[7] then LDFocus.SetFocus(pgm) Clipboard.SetText("%1") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[8] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+""+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[9] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"|f1=1"+cr+"{for |f1;10 ["+cr+"]"+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[10] then DrwGrd() elseif clb=bb[11] then rec=1 GraphicsWindow.Title="Recording moves... Hit RB to stop." GraphicsWindow.PenWidth=3 GraphicsWindow.PenColor ="Red elseif clb=bb[12] then mov=1 elseif clb=bb[13] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"{IF =%1;5 2 "+cr+"W#True"+cr+":$2 "+cr+"W#False"+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[14] then Controls.SetSize(pgm,800, gh - 360) elseif clb=bb[15] then fnm=LDDialogs.OpenFile("txt","i:\txt") If FilePlus.FileExists(fnm) then ' The following line could be harmful and has been automatically commented. ' fcc=File.ReadContents(fnm) LDControls.RichTextBoxSetText(pgm,fcc,"False") endif elseif clb=c5 then Helpp() elseif clb=c6 then cch=FCDialogs.AskForTextLine("Char to trace:") If text.GetCharacterCode (cch)>32 then GraphicsWindow.FontName="Times New Roman" GraphicsWindow.FontSize=540 GraphicsWindow.FontBold="True GraphicsWindow.FontItalic="True GraphicsWindow.BrushColor="#bbbbbb GraphicsWindow.DrawText(300,150,cch) endif elseif clb=bb[16] then rst=1 nww=1 src="{1"+cr LDControls.RichTextBoxClear (pgm) LDControls .RichTextBoxSetText (pgm, src,"False") else clicked = "True" endif EndSub Sub DoLine '----------------------------------------------LINEPROC----------------------------- linee= LDText.Trim (linee) If linee="" Or Text.StartsWith(linee,"//") Then Goto exx endif If tree[8][7]="AUTO" Then GraphicsWindow.PenColor=LDColours.HSLtoRGB(math.Remainder (ch,360) ,0.9,0.4) Else GraphicsWindow.PenColor=tree[8][7] endif ch=ch+1 While Text.IsSubText(linee,"%") dorepl() endwhile ree: If Text.StartsWith(linee, Text.GetCharacter (34)) Then 'virtual mode If _inn>0 Then linee=text.GetSubTextToEnd (linee,2) Goto ree Endif elseIf Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then vcnt=vcnt+1 mem[vcnt][1]=vv mem[vcnt][0]=vn elseif dfc="'" then rr=ldcall.Function("findvar",vn) mem[rr][1]=text.GetCharacter (vv) elseif dfc="." then pp=mathplus.ToNumber (text.GetSubText(linee,5,2)) scnt=scnt+1 Matr[scnt]=Text.GetSubTextToEnd ( vv,4) elseif dfc=";" then For scnt=1 to Text.GetLength (vv) Matr[scnt]=Text.GetSubText(vv,scnt,1) endfor elseif dfc="+" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]+vv elseif dfc="~" then rr=ldcall.Function("findvar",vn) mem[rr][1]=vv elseif dfc="*" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]*vv elseif dfc="/" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]/vv endif ElseIf Text.StartsWith(linee, "~B#") Then 'block wdth tww= Text.GetSubTextToEnd (linee,4) ElseIf Text.StartsWith(linee, "WB#") Then 'block txt ttx= Text.GetSubTextToEnd (linee,4) GraphicsWindow.DrawBoundText(Turtle.x, Turtle.y,tww,ttx) ElseIf Text.StartsWith(linee, "#O>") Then 'obj mode objm=1 oo=1 Program.Delay(5) obj[oo][1]=Turtle.X obj[oo][2]=Turtle.Y oo=oo+1 ElseIf Text.StartsWith(linee, "#O#") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,4) objm=0 opp[ttx]=LDShapes.AddPolygon (obj) ElseIf Text.StartsWith(linee, "#OM") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,5) ttt= LDText.Split (ttx,";") Shapes.Move (opp[ttt[3]],ttt[1]-obj[1][1],ttt[2]-obj[1][2]) ElseIf Text.StartsWith(linee, "#OA") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,5) ttt= LDText.Split (ttx,";") Shapes.Animate (opp[ttt[3]],ttt[1]-obj[1][1],ttt[2]-obj[1][2],ttt[4]) ElseIf Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif TextWindow.WriteLine(">:"+ttx) ElseIf Text.StartsWith(linee, "WRT") Then ttx= Text.GetSubTextToEnd (linee,5) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif GraphicsWindow.DrawText(Turtle.x, Turtle.y, ttx) elseif Text.StartsWith(linee, "F") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) if objm=1 then obj[oo][1]=Turtle.X obj[oo][2]=Turtle.Y oo=oo+1 endif 'GraphicsWindow.Title="Dst:"+math.Round ( dist*sc) if dbg then TextWindow.WriteLine(math.Floor (dist*sc)) endif Elseif Text.StartsWith(linee, "S") Then If Text.GetSubText(linee,2,1)="/" then sc=sc/ Text.GetSubTextToEnd(linee, 3) else sc=sc* Text.GetSubTextToEnd(linee, 3) endif If sc=0 then sc=1 EndIf ElseIf Text.StartsWith(linee, "$") Then tx=Turtle.x ty=Turtle.Y ta= Turtle.Angle ts=sc ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) Sst= sbb[scc]["Stt"] sen=sbb[scc]["End"] Stack.PushValue("locali", i) Stack.PushValue("localj", j) For i = sSt To sEn linee=line[i] _inn=_inn+1 DoLine() _inn=_inn-1 Endfor i = Stack.PopValue("locali")+1 j=Stack.PopValue("localj") ElseIf Text.StartsWith(linee, "&") Then Turtle.x=tx Turtle.Y=ty Turtle.Angle=ta sc=ts ElseIf Text.StartsWith(linee, "#X") Then FCExtensions.Eval(Text.GetSubTextToEnd(linee, 4)) ElseIf Text.StartsWith(linee, "#E") Then mem[1][1]=FCExtensions.MathEval(Text.GetSubTextToEnd(linee, 4)) ElseIf Text.StartsWith(linee, "#F") Then ff=Text.GetSubTextToEnd(linee, 4) fn=LDText.Split(ff,";") GraphicsWindow.FontName=fn[1] GraphicsWindow.FontBold=_tfl[fn[2]] GraphicsWindow.FontItalic=_tfl[fn[3]] GraphicsWindow.FontSize=fn[4] ElseIf Text.StartsWith(linee, "#P") Then GraphicsWindow.BrushColor=GraphicsWindow.PenColor ElseIf Text.StartsWith(linee, "~S") Then LDQueue.Enqueue("q1",Turtle.x+":"+Turtle.y) ElseIf Text.StartsWith(linee, "~G") Then tp=LDQueue.Dequeue ("q1") tt=LDText.Split(tp,":") Turtle.x=tt[1] Turtle.y=tt[2] ElseIf Text.StartsWith(linee, "#C") Then ww = MathPlus.ToNumber ( Text.GetSubTextToEnd(linee, 4)) GraphicsWindow.BrushColor=GraphicsWindow.PenColor If ww=0 then ww=5 endif GraphicsWindow.FillEllipse(Turtle.x-ww, Turtle.y-ww,ww*2,ww*2) ElseIf Text.StartsWith(linee, "XC") Then ww = MathPlus.ToNumber ( Text.GetSubTextToEnd(linee, 4)) GraphicsWindow.BrushColor=GraphicsWindow.BackgroundColor If ww=0 then ww=5 endif GraphicsWindow.FillEllipse(Turtle.x-ww, Turtle.y-ww,ww*2,ww*2) ElseIf Text.StartsWith(linee, "`C") Then ww = Text.GetSubTextToEnd(linee, 3) GraphicsWindow.BrushColor=ww ElseIf Text.StartsWith(linee, "~H") Then Turtle.x=600 Turtle.Y=400 Turtle.Angle=0 ElseIf Text.StartsWith(linee, "P") Then GraphicsWindow.PenColor=GraphicsWindow.BackgroundColor GraphicsWindow.PenWidth=GraphicsWindow.PenWidth+2 distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) GraphicsWindow.PenWidth=GraphicsWindow.PenWidth-2 ElseIf Text.StartsWith(linee, "~FN") Then GraphicsWindow.FontName=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~FS") Then GraphicsWindow.FontSize=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~C") Then ccl=GraphicsWindow.BrushColor GraphicsWindow.BrushColor =GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle (220,200,800,400) GraphicsWindow.BrushColor=ccl ElseIf Text.StartsWith(linee, "~T") Then mem[1][1]=Clock.Hour mem[1][0]="_H" mem[2][1]=Clock.Minute mem[2][0]="_M mem[3][1]=Clock.Second mem[3][0]="_S mem[4][1]=Clock.Date mem[4][0]="_D" ElseIf Text.StartsWith(linee, "~") Then Program.Delay (Text.GetSubTextToEnd(linee, 2)) ElseIf Text.StartsWith(linee, "U") Then Turtle.PenUp() ElseIf Text.StartsWith(linee, "D") Then Turtle.PenDown() ElseIf Text.StartsWith(linee, "R") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(dist) ElseIf Text.StartsWith(linee, "L") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(-dist) ElseIf Text.StartsWith(linee, "A") Then distance = -Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Angle=dist ElseIf Text.StartsWith(linee, ":$") Then icc=Text.GetSubTextToEnd (linee, 3) i=i+icc ElseIf Text.StartsWith(linee, "IF") Then icc=Text.GetSubTextToEnd (linee, 4) vz=text.GetIndexOf(icc,";") sk=text.GetIndexOf(icc," ") v1=text.GetSubText (icc,2,vz-2) v2=ldtext.trim(text.GetSubTexttoend (icc,vz+1)) ss=text.GetIndexOf(v2," ") v2=ESLText.Remove (v2,ss-1,text.GetLength(v2)-ss+1) If sk=0 then skp=2 Else skp=text.GetSubTextToEnd(icc,sk+1) endif cond=0 TextWindow.WriteLine ("Sk:"+Skp) If Text.StartsWith(icc,"=") then If v1=v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,">") then If v1v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,"!") then If v1<>v2 then cond=1 Else cond=2 endif endif If cond=0 then TextWindow.WriteLine ("IF invalid cond error!") else if cond=1 then 'true part TextWindow.WriteLine ("TRue") Else 'false part TextWindow.WriteLine ("Flss") i=i+skp endif endif ElseIf Text.StartsWith(linee, "{") Then count[_l] = mathplus.ToNumber ( Text.GetSubTextToEnd (linee, 2)) iStart[_l] = i + 1 iEnd[_l] = nLines nest = 0 tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 For k = iStart[_l] To nLines 'TextWindow.WriteLine(">>"+k) If Text.StartsWith(line[k], "{") Then nest = nest + 1 ElseIf Text.StartsWith(line[k], "]") or Text.StartsWith(line[k], "}") Then If nest = 0 Then iEnd[_l] = k - 1 k= nLines Else nest = nest - 1 EndIf EndIf EndFor If dbg then typ="Lp" tree[nc][13]=typ+":"+nest+">"+iStart[_l]+" to "+iEnd[_l] LDControls.TreeViewContent(trr,tree) nset() endif j = count[_l] _l = _l + 1 While j>0 Stack.PushValue("local", j) _inn=_inn+1 For i = iStart[_l - 1] To iEnd[_l - 1] linee=line[i] If Text.IsSubText (linee,"%$$") Then linee=LDText.Replace (linee,"%$$",j) elseIf Text.IsSubText (linee,"%$A") Then linee=LDText.Replace (linee,"%$A",Turtle.Angle ) elseIf Text.IsSubText (linee,"%$C") Then linee=LDText.Replace (linee,"%$C",GraphicsWindow.PenColor ) elseIf Text.IsSubText (linee,"%$") Then linee=LDText.Replace (linee,"%$","%"+ ESLMaths.HexFromInteger(j) ) endif If dbg then TextWindow.WriteLine (i+">>"+linee) endif DoLine() EndFor _inn=_inn-1 j = Stack.PopValue("local")-1 Endwhile _l = _l - 1 i = iEnd[_l] + 2 EndIf exx: EndSub Sub dorepl If Text.IsSubText (linee,"%") Then aq="!! If Text.IsSubText(linee,aq) Then m2=Text.Append("0", mem[2][1]) m2=Text.GetSubTextToEnd (m2,text.GetLength( mem[2][1])) m3=Text.Append("0", mem[3][1]) m3=Text.GetSubTextToEnd (m3,text.GetLength( mem[3][1])) endif If Text.IsSubText (linee,"%1") Then linee=LDText.Replace (linee,"%1",mem[1][1]) elseIf Text.IsSubText (linee,"%2"+aq) Then linee=LDText.Replace (linee,"%2"+aq,m2) elseIf Text.IsSubText (linee,"%3"+aq) Then linee=LDText.Replace (linee,"%3"+aq,m3) elseIf Text.IsSubText (linee,"%2") Then linee=LDText.Replace (linee,"%2",mem[2][1]) elseIf Text.IsSubText (linee,"%3") Then linee=LDText.Replace (linee,"%3",mem[3][1]) elseIf Text.IsSubText (linee,"%4") Then linee=LDText.Replace (linee,"%4",mem[4][1]) elseIf Text.IsSubText (linee,"%5") Then linee=LDText.Replace (linee,"%5",mem[5][1]) elseIf Text.IsSubText (linee,"%6") Then linee=LDText.Replace (linee,"%6",mem[6][1]) elseIf Text.IsSubText (linee,"%7") Then linee=LDText.Replace (linee,"%7",mem[7][1]) elseIf Text.IsSubText (linee,"%8") Then linee=LDText.Replace (linee,"%8",mem[8][1]) elseIf Text.IsSubText (linee,"%9") Then linee=LDText.Replace (linee,"%9",mem[9][1]) elseIf Text.IsSubText (linee,"%A") Then linee=LDText.Replace (linee,"%A",mem[10][1]) elseIf Text.IsSubText (linee,"%B") Then linee=LDText.Replace (linee,"%B",mem[11][1]) elseIf Text.IsSubText (linee,"%C") Then linee=LDText.Replace (linee,"%C",mem[12][1]) elseIf Text.IsSubText (linee,"%D") Then linee=LDText.Replace (linee,"%D",mem[13][1]) elseIf Text.IsSubText (linee,"%E") Then linee=LDText.Replace (linee,"%E",mem[14][1]) elseIf Text.IsSubText (linee,"%F") Then linee=LDText.Replace (linee,"%F",mem[15][1]) elseIf Text.IsSubText (linee,"%M") Then mm=text.GetSubTextToEnd(linee,text.GetIndexOf(linee,".")+1) linee=LDText.Replace (linee,"%M."+mm,matr[MathPlus.ToNumber(mm)]) elseIf Text.IsSubText (linee,"%X") Then linee=LDText.Replace (linee,"%X",math.Round (Turtle.x)) elseIf Text.IsSubText (linee,"%Y") Then linee=LDText.Replace (linee,"%Y",math.Round (Turtle.y)) elseIf Text.IsSubText (linee,"%W") Then linee=LDText.Replace (linee,"%W",math.Remainder (Turtle.Angle,360) ) endif endif endsub Sub fWriteLn TextWindow.WriteLine(idd+args[1]) EndSub Sub xpline '**************************************xplains prg....********************* If Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then LDCall.Function("fWriteLn","Define New VAR "+vn+" and assign value:"+vv) vcnt=vcnt+1 mem[vcnt][0]=vn elseif dfc="+" then LDCall.Function("fWriteLn","Increase VAR "+vn+" by:"+vv) elseif dfc="~" then LDCall.Function("fWriteLn","Find VAR "+vn+" and assign value:"+vv) elseif dfc="*" then LDCall.Function("fWriteLn","Multiply VAR "+vn+" by:"+vv) elseif dfc="/" then LDCall.Function("fWriteLn","Divide VAR "+vn+" by:"+vv) endif endif If Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) LDCall.Function("fWriteLn","Write to console:"+ttx) ElseIf Text.StartsWith(linee, "%") then LDCall.Function("fWriteLn","Perform "+Text.GetSubTextToEnd (linee,4)) ElseIf Text.StartsWith(linee, "WRT") Then 'turtle writting ttx= Text.GetSubTextToEnd (linee,5) LDCall.Function("fWriteLn","Write to screen:"+ttx) ElseIf Text.StartsWith(linee, "Ht") Then LDCall.Function("fWriteLn","Reset to Home pos.") elseif Text.StartsWith(linee, "F") Then dist = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(dist,"%") then dist = "var value:"+mem[ESLMaths.HexToInteger ( mathplus.ToNumber ( Text.GetSubTextToEnd(dist, 2)))][0] endif LDCall.Function("fWriteLn","Forward by:"+ dist) Elseif Text.StartsWith(linee, "<") Then ttx= Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","") Then idd=text.GetSubTextToEnd(idd,3) LDCall.Function("fWriteLn",">END SUB.") Elseif Text.StartsWith(linee, "]") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","] END Repeat block") Elseif Text.StartsWith(linee, "}") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","} END block") Elseif Text.StartsWith(linee, "S") Then If sc=0 then sc=1 LDCall.Function("fWriteLn","Set scale to 1") else If Text.GetSubText(linee,2,1)="%" then LDCall.Function("fWriteLn","Alter scale <(kind +/*) selected by VAR:"+mem[ESLMaths.HexToInteger ( mathplus.ToNumber ( Text.GetSubText(linee, 3,1)))][0]+"> by factor:"+Text.GetSubTextToEnd(linee, 5)) elseIf Text.GetSubText(linee,2,1)="/" then LDCall.Function("fWriteLn","Divide scale by:"+Text.GetSubTextToEnd(linee, 3)) else LDCall.Function("fWriteLn","Multiply scale by:"+Text.GetSubTextToEnd(linee, 3)) endif EndIf ElseIf Text.StartsWith(linee, "$") Then LDCall.Function("fWriteLn","Save turtle pos.") ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","Call sub:"+sbb[scc][0]) ElseIf Text.StartsWith(linee, "&") Then LDCall.Function("fWriteLn","Restore turtle pos.") ElseIf Text.StartsWith(linee, "U") Then LDCall.Function("fWriteLn","Pen UP - moving") ElseIf Text.StartsWith(linee, "D") Then LDCall.Function("fWriteLn","Pen DN - drawing") ElseIf Text.StartsWith(linee, "R") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn RIGHT by:"+dist) ElseIf Text.StartsWith(linee, "L") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn LEFT by:"+dist) ElseIf Text.StartsWith(linee, "{") Then LDCall.Function("fWriteLn","{Repeat block times:"+Text.GetSubTextToEnd(linee,2)) idd=idd+" " EndIf EndSub'---------------------------------xplain********************** Sub Init gw = 1000 gh = 900 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Turtle Graphics GraphicsWindow.BackgroundColor="#bbccdd GraphicsWindow.Top=0 GraphicsWindow.Left=0 Turtle.Speed=10 CR = ESLText.CRLF src=LDText.Replace ( deff[8],"!",ESLText.CRLF ) EndSub Sub Helpp txx="Spec.vars :"+ESLText.CRLF txx=txx+">only shows :"+ESLText.CRLF txx=txx+"%$$ = loop counter backward"+ESLText.CRLF txx=txx+"%$A = Turtle.Angle"+ESLText.CRLF txx=txx+"%$C = Pen color"+ESLText.CRLF txx=txx+"%$n = n=[ 1..F(hex)] ref. in loop to vars 1..15"+ESLText.CRLF txx=txx+ESLText.CRLF+"Spec.cmds:"+ESLText.CRLF txx=txx+"%M.nn= matrix row nn _1..99"+ESLText.CRLF txx=txx+"|vv;txt <= stores txt as chars in matrix %M"+ESLText.CRLF txx=txx+"|vv~nnn <= stores data in existing var vv"+ESLText.CRLF txx=txx+"|vv=nnn <= stores data in new var vv"+ESLText.CRLF txx=txx+"|vv+nnn <= adds value to var vv"+ESLText.CRLF txx=txx+"|vv*nnn <= multipl. value to var vv"+ESLText.CRLF txx=txx+"|vv/nnn <= divides var vv by val."+ESLText.CRLF txx=txx+"|vv'cccc <= stores chr unicode cccc to var vv"+ESLText.CRLF txx=txx+"~n = delay n msecs"+ESLText.CRLF txx=txx+"#C ww = fill circle rad.ww px"+ESLText.CRLF txx=txx+"XC ww = del. circle rad.ww px"+ESLText.CRLF txx=txx+"~C = del. watch zone"+ESLText.CRLF txx=txx+"$ = save turtle loc."+ESLText.CRLF txx=txx+"& = restore turtle loc."+ESLText.CRLF txx=txx+"#F fnam;bld;itl;siz = set font name, bold 0 or 1, italic 0/1, size"+ESLText.CRLF txx=txx+"#P = set pen clr from treedef."+ESLText.CRLF txx=txx+"~H = Home turtle"+ESLText.CRLF txx=txx+"#E xpr = matheval xpr expression"+ESLText.CRLF txx=txx+"#X cmd = exec. sb cmd"+ESLText.CRLF GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Tahoma" GraphicsWindow.FontSize = 15 GraphicsWindow.PenColor="Black GraphicsWindow.DrawText(310, 20, "S ff | S/ff = scale") GraphicsWindow.DrawText(310, 40, "F dist=move forward") GraphicsWindow.DrawText(310, 60, "L|R angle = turn angle") GraphicsWindow.DrawText(310, 80, "D)wn | U)p = pen mode") GraphicsWindow.DrawText(310, 105, " sub end") GraphicsWindow.DrawText(310, 165, "@n = sub call n=1..maxnsub by def. order ") GraphicsWindow.DrawText(310, 190, "{count ") GraphicsWindow.DrawText(310, 210, "loop cmds ") GraphicsWindow.DrawText(310, 230, "] or } loop end") GraphicsWindow.DrawBoundText(310,250,350,txx) EndSub End>QPJ207.sb< Start>QPR908.sb< dw=1000 dh=dw GraphicsWindow.width=dw GraphicsWindow.Height=dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title ="Flakestar GraphicsWindow.BackgroundColor ="darkblue args =0 cc=ldtext.Split ("white cyan darkblue" " ") brr=ldshapes.BrushGradient(cc "") LDGraphicsWindow.BackgroundBrush(brr) For pss=0 to 3 ii=0 T_x=320 T_y=850 rd=0 bl=0 bend[1]=60 bend[2]=-120 bend[3]=60 bend[4]=0 T_angle =(60) pn=1 For corner =1 To 3 For m4=1 to 4 For m3=1 to 4 For m2=1 to 4 For m1=1 to 4 wiggle() T_angle=T_angle+(bend[m1]) endfor T_angle=T_angle+(bend[m2]) endfor T_angle=T_angle+(bend[m3]) endfor T_angle=T_angle+(bend[m4]) endfor T_angle=T_angle-120 endfor endfor GraphicsWindow.PenWidth=0 GraphicsWindow.BrushColor=LDColours.Coral Sub wiggle ldcall.Function ("t_move" 3) T_angle=T_angle+(60) ldcall.Function ("t_move" 3) T_angle=T_angle+(-120) ldcall.Function ("t_move" 3) T_angle=T_angle+(60) ldcall.Function ("t_move" 3) EndSub sub t_Move ds=args[1] mm=LDMath.Convert2Cartesian (t_x,t_y,ds, t_Angle-90 ) If pss=2 Then GraphicsWindow.BrushColor =LDColours.HSLtoRGB (ii 1 0.5) ii=ii+0.12 GraphicsWindow.fillEllipse (mm[1] mm[2] 10 10) ElseIf pss=3 then GraphicsWindow.BrushColor ="darkblue GraphicsWindow.fillEllipse (mm[1]+3 mm[2]+3 4 4) Elseif pss=1 then GraphicsWindow.BrushColor =LDColours.HSLtoRGB (ii 1 0.5) ii=ii-0.12 GraphicsWindow.fillEllipse (mm[1]-3 mm[2]-3 16 16) Else GraphicsWindow.BrushColor ="white GraphicsWindow.fillEllipse (mm[1]-6 mm[2]-6 22 22) EndIf t_x= (mm[1]) t_y= (mm[2]) EndSub End>QPR908.sb< Start>QPT946.sb< startover: clearMemory() GraphicsWindow.Width=300 GraphicsWindow.Height=350 S1=0 S2=0 Tick="C:\Users\Behnam\Desktop\Basic\sounds\Tick.mp3" Win="C:\Users\Behnam\Desktop\Basic\sounds\Win.mp3" GraphicsWindow.BrushColor="black" GraphicsWindow.Title="Tic-Tac-Toe" GraphicsWindow.DrawText(0, 0, "Developed by Behnam Azizi") menu() 'If XimageLink="0" then 'XimageLink= "http://www.openoysternyc.com/wp-content/uploads/2012/06/Red-X.png" 'ElseIf CimageLink="0" then ' CimageLink="http://1.bp.blogspot.com/_M8xP4guXcz8/Sm1tVt3fdKI/AAAAAAAAACg/ty11VDgBAtE/s320/immigration-canada-circle.jpg" 'endif TextWindow.Hide() frame() GraphicsWindow.KeyDown=handleKey ' ------------------------------------------ SUBS ------------------------------------------- Sub handleKey K=GraphicsWindow.LastKey i=200 j=0 If Math.Remainder(t, 2)=0 Then circle() Sound.Stop(Tick) Sound.Play(Tick) Else cross() Sound.Stop(Tick) Sound.Play(Tick) EndIf t=t+1 winner() If t=9 Then GraphicsWindow.ShowMessage("It's a draw! No one wins!", "Draw") clearMemory() EndIf EndSub Sub frame score() For p=0 To 300 Step 100 For q=0 To 300 Step 100 GraphicsWindow.DrawRectangle(0, 20, p, q) EndFor EndFor EndSub Sub circle circle= ImageList.LoadImage(CimageLink) If K= "Escape" Then menu() EndIf If K= "NumPad7" And x[1][1]=0 Then O[1][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 20, 100, 100) ElseIf K= "NumPad8" and x[1][2]=0 Then O[1][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 20, 100, 100) ElseIf K= "NumPad9" and x[1][3]=0 Then O[1][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 20, 100, 100) ElseIf K= "NumPad6" and x[2][3]=0 Then O[2][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 120, 100, 100) ElseIf K= "NumPad1" and x[3][1]=0 Then O[3][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 220, 100, 100) ElseIf K= "NumPad2" and x[3][2]=0 Then O[3][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 220, 100, 100) ElseIf K= "NumPad3" and x[3][3]=0 Then O[3][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 220, 100, 100) ElseIf K= "NumPad4" and x[2][1]=0 Then O[2][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 120, 100, 100) ElseIf K= "NumPad5" and x[2][2]=0 Then O[2][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 120, 100, 100) Else t=t-1 Endif EndSub Sub cross circle= ImageList.LoadImage(XimageLink) If K= "NumPad7" and O[1][1]=0 Then x[1][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 20, 100, 100) ElseIf K= "NumPad8" and O[1][2]=0 Then x[1][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 20, 100, 100) ElseIf K= "NumPad9" and O[1][3]=0 Then x[1][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 20, 100, 100) ElseIf K= "NumPad6" and O[2][3]=0 Then x[2][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 120, 100, 100) ElseIf K= "NumPad1" and O[3][1]=0 Then x[3][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 220, 100, 100) ElseIf K= "NumPad2" and O[3][2]=0 Then x[3][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 220, 100, 100) ElseIf K= "NumPad3" and O[3][3]=0 Then x[3][3]=1 GraphicsWindow.DrawResizedImage(circle, 200, 220, 100, 100) ElseIf K= "NumPad4" and O[2][1]=0 Then x[2][1]=1 GraphicsWindow.DrawResizedImage(circle, 0, 120, 100, 100) ElseIf K= "NumPad5" and O[2][2]=0 Then x[2][2]=1 GraphicsWindow.DrawResizedImage(circle, 100, 120, 100, 100) Else t=t-1 EndIf EndSub Sub winner ' 1 2 3 4 5 6 7 8 If (O[1][1]=1 And O[1][2]=1 And O[1][3]=1) Or (O[2][1]=1 And O[2][2]=1 And O[2][3]=1) Or (O[3][1]=1 And O[3][2]=1 And O[3][3]=1) Or (O[1][1]=1 And O[2][1]=1 And O[3][1]=1) Or (O[1][2]=1 And O[2][2]=1 And O[3][2]=1) Or (O[1][3]=1 And O[2][3]=1 And O[3][3]=1) Or (O[1][1]=1 And O[2][2]=1 And O[3][3]=1) Or (O[1][3]=1 And O[2][2]=1 And O[3][1]=1) Then Sound.Stop(Win) Sound.Play(Win) GraphicsWindow.ShowMessage(P1+" beat you! "+P2+", you're such a loser!", "Game Over") S1 = S1 + 100 clearMemory() 'Goto start ' 1 2 3 4 5 6 7 8 ElseIf (x[1][1]=1 And x[1][2]=1 And x[1][3]=1) Or (x[2][1]=1 And x[2][2]=1 And x[2][3]=1) Or (x[3][1]=1 And x[3][2]=1 And x[3][3]=1) Or (x[1][1]=1 And x[2][1]=1 And x[3][1]=1) Or (x[1][2]=1 And x[2][2]=1 And x[3][2]=1) Or (x[1][3]=1 And x[2][3]=1 And x[3][3]=1) Or (x[1][1]=1 And x[2][2]=1 And x[3][3]=1) Or (x[1][3]=1 And x[2][2]=1 And x[3][1]=1) then Sound.Stop(Win) Sound.Play(Win) GraphicsWindow.ShowMessage(P2+" beat you! "+ P1+", you're such a loser!", "Game Over") S2 = S2 +100 clearMemory() EndIf EndSub Sub clearMemory For i=0 To 3 For j=0 to 3 O[i][j]=0 x[i][j]=0 EndFor EndFor t=0 GraphicsWindow.Clear() frame() GraphicsWindow.DrawText(10, 0, "Developed by Behnam Azizi") EndSub Sub score GraphicsWindow.DrawText(0, 320, P1+": "+S1) GraphicsWindow.DrawText(220, 320, P2+": "+S2) EndSub Sub menu clearMemory() theme() TextWindow.WriteLine("Player 1, please enter your name:") P1= TextWindow.Read() TextWindow.WriteLine("Player 2, please enter your name:") P2 = TextWindow.Read() repeat: TextWindow.WriteLine("Do you want to choose your team flags?(y/n)") ans= TextWindow.Read() If ans="y" then TextWindow.WriteLine("Player 1, please enter the URL to your team flag:") CimageLink=TextWindow.Read() TextWindow.WriteLine("Player 2, please enter the URL to your team flag:") XimageLink=TextWindow.Read() elseif ans="n" then else Goto repeat endif TextWindow.Hide() EndSub Sub theme TextWindow.WriteLine("Please select the theme from one of the list below:") TextWindow.WriteLine("1) Apple vs. Orange") TextWindow.WriteLine("2) Obama vs. Mitt Romney") TextWindow.WriteLine("3) Canada vs. US") TextWindow.WriteLine("4) Spidermman vs. Batman") theme= TextWindow.ReadNumber() CimageLink="http://www.gecko.co.uk/sites/default/files/orange.jpg" XimageLink="http://www.statesymbolsusa.org/IMAGES/New_York/redrome.jpg" If theme=2 then CimageLink="http://4.bp.blogspot.com/-84_alSCxgQs/T70mj27p9sI/AAAAAAAACos/bOclmysmSRY/s1600/regardduweb-drole-insolite-celebrite-obama17.jpg" XimageLink="http://markamerica65.files.wordpress.com/2012/01/mitt-romney-md.jpg" ElseIf theme=3 then CimageLink="http://grostracteurspassion.com/Public/Images/Paragraphe/2429/1_1.jpg" XimageLink="http://burchhigh.us/yahoo_site_admin/assets/images/Animated-Flag-USA.348112557_std.gif" ElseIf theme=4 then CimageLink="http://popbytes.com/img/spiderman3-1.jpg" XimageLink="https://si0.twimg.com/profile_images/2332791338/Batman-Logo-batman-9683803-1280-1024.jpg" EndIf EndSub End>QPT946.sb< Start>QPV250.sb< balloon1_x = 0 balloon1_y = 0 cannon1_x = 375 cannon1_y = 350 GraphicsWindow.KeyDown = moveCannon GraphicsWindow.Width = "800" GraphicsWindow.Height = "500" GraphicsWindow.Show() RESOURCE_PATH = Program.Directory + "\" CANNON_IMAGE = imagelist.LoadImage(RESOURCE_PATH + "cannon.png") BALLOON_IMG = imagelist.LoadImage(RESOURCE_PATH + "balloon.png") C_W= ImageList.GetWidthOfImage(CANNON_IMAGE) B_W= ImageList.GetWidthOfImage(BALLOON_IMG) B_H= ImageList.GetheightOfImage(BALLOON_IMG) balloon = Shapes.AddImage(BALLOON_IMG) cannon = Shapes.AddImage(CANNON_IMAGE) Shapes.Move(cannon, cannon1_x , cannon1_y) Shapes.Move(balloon, balloon1_x , balloon1_y) PM=1 shoot="False" While "True" dx=5*PM Shapes.Move(balloon,Shapes.GetLeft(balloon)+dx,Shapes.GetTop(balloon)) If Shapes.GetLeft(balloon)+B_W/2>800 Then Shapes.Move(balloon,Shapes.GetLeft(balloon)-2*dx,Shapes.GetTop(balloon)) PM=-PM ElseIf Shapes.GetLeft(balloon)+B_W/2<0 Then Shapes.Move(balloon,Shapes.GetLeft(balloon)-2*dx,Shapes.GetTop(balloon)) PM=-PM EndIf If shoot Then Shapes.Move(cannon,Shapes.GetLeft(cannon),Shapes.GetTop(cannon)-4) collision() If Shapes.GetTop(cannon)<-100 then shoot="False" Shapes.Move(cannon,Shapes.GetLeft(cannon),cannon1_y) EndIf EndIf Program.Delay(10) EndWhile Sub collision If math.Abs(Shapes.GetLeft(cannon)+C_W/2-Shapes.GetLeft(balloon)-B_W/2)balloon1_y Then Hit="True" Hit_count=Hit_Count+1 shoot="False" GraphicsWindow.Title="Hit Counts= "+Hit_count Program.Delay(1000) Shapes.Move(cannon,Shapes.GetLeft(cannon),cannon1_y) EndIf EndSub Sub moveCannon If GraphicsWindow.LastKey = "Right" Then ' arrow key or "D" cannon1_x = cannon1_x + 20 If cannon1_x+C_W>800 Then cannon1_x=800-C_W EndIf Shapes.Move(cannon, cannon1_x, cannon1_y) ElseIf GraphicsWindow.LastKey = "Left" Then ' arrow key or "A" cannon1_x = cannon1_x - 20 If cannon1_x<0 Then cannon1_x=0 EndIf Shapes.Move(cannon, cannon1_x, cannon1_y) Elseif GraphicsWindow.LastKey = "Space" Then shoot="True" EndIf EndSub End>QPV250.sb< Start>QPX832.sb< ' Easy Graf making Controlbox data Input version 2011/12/21 by NaoChanON GraphicsWindow.Top=30 GraphicsWindow.Left=50 GraphicsWindow.Width=1000 GraphicsWindow.Height=600 GraphicsWindow.BackgroundColor="Lavender" GraphicsWindow.Show() Controls.ButtonClicked=Onclick TextBoX_Input() Sub OnClick name="" name=controls.LastClickedButton ' Last button nm=controls.GetButtonCaption(name) ' Button's caption If nm="Execute" Then get_data() init() Plot_Data() Regressionline() EndIf EndSub Sub TextBoX_Input GraphicsWindow.BrushColor="Red" GraphicsWindow.FontSize=30 GraphicsWindow.DrawText(80,5," Input boxes and push execute ") EXEC=Controls.AddButton("Execute",230,540) Controls.SetSize(EXEC,300,50) GraphicsWindow.FontSize=20 GraphicsWindow.BrushColor="Navy" GraphicsWindow.FontSize=15 GraphicsWindow.DrawText(30,50,"Graf Width,Height") ' Width and height GraphicsWindow.DrawText(30,70,"EXAM: 800,500") GXYBOX= Controls.AddTextBox(230,50) Controls.SetSize(GXYBOX,100,40) Controls.SetTextBoxText(GXYBOX,"800,500") GraphicsWindow.DrawText(30,120,"Min-X , Max-X") ' Min-X and Max-X GraphicsWindow.DrawText(30,140,"EXAM: 0,800") MINMAXX= Controls.AddTextBox(230,120) Controls.SetSize(MINMAXX,100,40) Controls.SetTextBoxText(MINMAXX,"0,800") GraphicsWindow.DrawText(30,190,"Min-Y , Max-Y") 'Min-Y and Max-Y GraphicsWindow.DrawText(30,210,"EXAM: 0,500") MINMAXY= Controls.AddTextBox(230,190) Controls.SetSize(MINMAXY,100,40) Controls.SetTextBoxText(MINMAXY,"0,500") GraphicsWindow.DrawText(30,260,"Dividing X , Y") ' dividing number GraphicsWindow.DrawText(30,280,"EXAM: 4,5") DivBOX= Controls.AddTextBox(230,260) Controls.SetSize(DivBOX,100,40) Controls.SetTextBoxText(DivBOX,"4,5") GraphicsWindow.DrawText(30,330,"Label X") ' Label-X name GraphicsWindow.DrawText(30,350,"EXAM: Weight") LABELXBOX=Controls.AddTextBox(230,330) Controls.SetSize(LABELXBOX,300,40) Controls.SetTextBoxText(LABELXBOX," Label X ") GraphicsWindow.DrawText(30,400,"Label Y") ' Label-Y name GraphicsWindow.DrawText(30,420,"EXAM: Height") LABELYBOX=Controls.AddTextBox(230,400) Controls.SetSize(LABELYBOX,300,40) Controls.SetTextBoxText(LABELYBOX," Label Y ") GraphicsWindow.DrawText(30,470,"Title name") ' Title name GraphicsWindow.DrawText(30,490,"EXAM: Weight vs Height") TTLBOX=Controls.AddTextBox(230,470) Controls.SetSize(TTLBOX,300,40) Controls.SetTextBoxText(TTLBOX," Test Graph ") GraphicsWindow.DrawText(660,5,"Input X , Y data") ' X,Y data GraphicsWindow.DrawText(660,25,"EXAM: 50 , 100 enter") GraphicsWindow.DrawText(720,45,"80 , 150 enter") MBOX= Controls.AddMultiLineTextBox(700,80) Controls.SetSize(MBOX,100,500) Controls.SetTextBoxText(MBOX," 50,100") EndSub Sub get_data GWH=Controls.GetTextBoxText(GXYBOX) GWidth= Text.GetSubText(GWH,1,text.GetIndexOf(GWH,",")-1) ' Gwidth GHeight=Text.GetSubTextToEnd(GWH,text.GetIndexOf(GWH,",")+1) 'Ghight MMX=Controls.GetTextBoxText(MINMAXX) MinX= Text.GetSubText(MMX,1,text.GetIndexOf(MMX,",")-1) ' Min-X MaxX=Text.GetSubTextToEnd(MMX,text.GetIndexOf(MMX,",")+1) 'Max-X MMY=Controls.GetTextBoxText(MINMAXY) MinY= Text.GetSubText(MMY,1,text.GetIndexOf(MMY,",")-1) 'Min-Y MaxY=Text.GetSubTextToEnd(MMY,text.GetIndexOf(MMY,",")+1) 'Max-Y DXY=Controls.GetTextBoxText(DivBOX) XDiv= Text.GetSubText(DXY,1,text.GetIndexOf(DXY,",")-1) 'X-Dividing number YDiv=Text.GetSubTextToEnd(DXY,text.GetIndexOf(DXY,",")+1) 'Y-Dividing number LBLX=Controls.GetTextBoxText(LABELXBOX) ' Label-X LBLY=Controls.GetTextBoxText(LABELYBOX) ' Label-Y TTL=Controls.GetTextBoxText(TTLBOX) ' Title name DatXY=Controls.GetTextBoxText(MBOX) ' X-Y data Get_XYata() ' Pick Up X,Y data from multilinetextbox EndSub Sub Get_XYata ' Pick Up X,Y data from multilinetextbox DatXY=Controls.GetTextBoxText(MBOX) If Text.GetCharacterCode(text.GetSubText(DatXY,Text.GetLength(datXY),1))=10 Then DatXY= text.GetSubText(DatXY,1,Text.GetLength(datXY)-2) ' if DatXY -end = Chr$(13)+chr$(10) then delete EndIf For i=1 To Text.GetLength(DatXY) word1=text.GetSubText(datXY,i,1) If word1=text.GetCharacter(13) Then ' delete chr$(13) word1="" ElseIf word1=text.GetCharacter(10) Then ' conversion Chr$(10) to ":" =delimiter word1=":" EndIf midw=text.Append(midw,word1) EndFor midw=midw+":" ' connect all word and add ":" =delimiter while midw<>"" NN=NN+1 midp1=Text.GetIndexOf(midw,",") midp2=Text.GetIndexOf(midw,":") px[NN]=Text.GetSubText(midw,1,midp1-1) ' pick up X-data py[NN]=Text.GetSubText(midw,midp1+1,midp2-midp1-1) ' pick up Y-data midw=Text.GetSubTextToEnd(midw,midp2+1) EndWhile EndSub Sub init GraphicsWindow.Clear() GraphicsWindow.top=50 GraphicsWindow.Left=50 GraphicsWindow.Width=1000 GraphicsWindow.Height=650 GraphicsWindow.Show() GraphicsWindow.BackgroundColor="Lightcyan" GraphicsWindow.BrushColor="Navy" GraphicsWindow.PenColor="Red" ' Draw Rectangle GTop=60 GLeft=150 GraphicsWindow.DrawRectangle(Gleft,Gtop,GWidth,GHeight) ' Title and X,Y-labels GraphicsWindow.FontSize=30 GTitle=Shapes.AddText(TTL) Shapes.Animate(GTitle,Gleft+150,Gtop-40,1000) LabelY=Shapes.AddText(LBLY) Shapes.Animate(LabelY,15,(Gtop+GHeight)/2,1500) Shapes.Rotate(LabelY,-90) LabelX=Shapes.AddText(LBLX) Shapes.Animate(LabelX,(Gleft+Gwidth)/2-20,Gtop+GHeight+40,2000) ' X-----Axis GraphicsWindow.FontSize=20 GraphicsWindow.BrushColor="Red" For i= 0 To XDiv For j=GTop To GTop+Gheight-5 Step 10 GraphicsWindow.DrawLine(Gleft+i*(Gwidth/Xdiv),J,Gleft+i*(Gwidth/Xdiv),j+5) EndFor DivX=math.round(minX+i*((MaxX-minX)/Xdiv)) GraphicsWindow.DrawText(Gleft+i*(Gwidth/Xdiv)-20,GTop+GHeight+10,DivX) EndFor ' Y---Axis For i= YDiv To 0 Step -1 For j=GLeft To GLeft+Gwidth-5 Step 10 GraphicsWindow.DrawLine(j,GTop+i*(GHeight/Ydiv),j+5,GTop+i*(GHeight/Ydiv)) EndFor DivY=math.Round(MaxY-i*((MaxY-minY)/Ydiv)) GraphicsWindow.DrawText(Gleft-40,GTop+i*(GHeight/Ydiv)-10,DivY) EndFor EndSub Sub Plot_Data GraphicsWindow.PenColor="Green" GraphicsWindow.PenWidth=3 For i=1 To NN plotx=Gleft + (PX[i]-minX)*Gwidth/(MaxX-MinX) ploty=GTop + Gheight- (PY[i]-minY)*Gheight/(MaxY-MinY) sc[i]=Shapes.AddEllipse(10,10) Shapes.Animate(sc[i],plotx-5,ploty-5,1000) EndFor EndSub Sub Regressionline For i=1 To NN sumx=sumx+px[i] sumy=sumy+py[i] sumX2=sumX2+px[i]*px[i] sumXY=sumXY+px[i]*py[i] sumY2=sumY2+py[i]*py[i] EndFor slope=(NN*sumXY-sumx*sumy)/(NN*sumx2-sumx*sumx) ' slope a slope=math.Round(slope*100)/100 ' round a intercept=sumy/NN-slope*sumx/NN ' intercept b intercept=math.Round(intercept*100)/100 ' round b Reg_line="y= "+slope+"X + "+intercept ' y= aX+b sreg=Shapes.AddText(Reg_line) Shapes.Animate(sreg,Gleft+10,80,1500) regY1=slope*minx+intercept ' X=MinX Y= intercept regY2=maxY*0.8 ' Y=maxY*0.8 regx2=(regY2-intercept)/slope ' X at Y Gregx1=Gleft 'conversion x1=minX GregX2=Gleft + (regx2-minX)*Gwidth/(MaxX-MinX) ' conversion x2 Gregy1=GTop + Gheight- (regY1-minY)*Gheight/(MaxY-MinY) ' conversion y1 Gregy2=GTop + Gheight- (regY2-minY)*Gheight/(MaxY-MinY) ' conversion y2 slope2=(NN*sumXY-sumx*sumy)/(NN*sumY2-sumY*sumY) ' slope c slope2=math.Round(slope2*100)/100 ' round c Coefficient=Math.SquareRoot(slope*slope2) 'Correlation coefficient Coefficient=math.Round(Coefficient*1000)/1000 scoef= Shapes.AddText("Coefficient= "+Coefficient) Shapes.Animate(scoef,Gleft+10,100,1500) GraphicsWindow.PenColor="Green" GraphicsWindow.DrawLine(Gregx1,GregY1,GregX2,GregY2) ' draw regression Line EndSub End>QPX832.sb< Start>QPZ194.sb< GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.Width = 388 GraphicsWindow.Height = 316 GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GraphicsWindow.BrushColor = "White" GraphicsWindow.PenColor = "White" GraphicsWindow.FontSize = 60 Text1 = Shapes.AddText("0") Shapes.Move(Text1,135,15) Text2 = Shapes.AddText("0") Shapes.Move(Text2,210,15) FootBall = Shapes.AddRectangle(10,6) P1S = 0 P2S = 0 PaddHieght = 30 PaddSpeed = 2 speed = PaddSpeed PaddOffScreen = "Bounce" Padd1 = Shapes.AddRectangle(5,PaddHieght) Padd2 = Shapes.AddRectangle(5,PaddHieght) Padd3 = Shapes.AddRectangle(5,PaddHieght) Padd4 = Shapes.AddRectangle(5,PaddHieght) y1 = 150 y2 = 150 FSpeedX = 2 FSpeedY = 1.2 dx = FSpeedX dy = FSpeedY y = (GraphicsWindow.Height / 2) -5 x = (GraphicsWindow.Width / 2) -5 For i = 20 to GraphicsWindow.Height - 20 Step 10 GraphicsWindow.FillRectangle((GraphicsWindow.Width / 2) -5,i,5,5) EndFor While 1 = 1 Program.Delay(5) y1 = y1 + Dy1 y2 = y2 + Dy2 Shapes.SetText(Text1,P1S) Shapes.SetText(Text2,P2S) x = x + dx y = y + dy GraphicsWindow.PenWidth = 5 GraphicsWindow.DrawLine(20,15,GraphicsWindow.Width - 20,15) GraphicsWindow.DrawLine(20,GraphicsWindow.Height - 20,GraphicsWindow.Width - 20,GraphicsWindow.Height - 20) GraphicsWindow.DrawLine(20,12,20,75) GraphicsWindow.DrawLine(GraphicsWindow.Width - 20,12,GraphicsWindow.Width - 20,75) GraphicsWindow.DrawLine(20,GraphicsWindow.Height - 17,20,GraphicsWindow.Height - 75) GraphicsWindow.DrawLine(GraphicsWindow.Width - 20,GraphicsWindow.Height - 17,GraphicsWindow.Width - 20,GraphicsWindow.Height - 75) GraphicsWindow.Title = "FootBall Game" Shapes.Move(FootBall,x,y) Shapes.Move(Padd1,35,y1) Shapes.Move(Padd2,105,y2) Shapes.Move(Padd3,GraphicsWindow.Width - 43,y2) Shapes.Move(Padd4,GraphicsWindow.Width - 105,y1) If PaddOffScreen = "Bounce" Then CheckBounce() EndIf If PaddOffScreen = "Reset" Then CheckReset() EndIf If x > 25 And x < 35 + 5 And y > y1 And y < y1 + PaddHieght Then BounceX() EndIf If x > GraphicsWindow.Width Then y = (GraphicsWindow.Height / 2) -5 x = (GraphicsWindow.Width / 2) -5 dx = FSpeedX dy = FSpeedY P1S = P1S + 1 EndIf If x < 0 Then y = (GraphicsWindow.Height / 2) -5 x = (GraphicsWindow.Width / 2) -5 dx = FSpeedX dy = FSpeedY P2S = P2S + 1 EndIf If x > GraphicsWindow.Width - 115 And x < GraphicsWindow.Width - 105 + 5 And y > y1 And y < y1 + PaddHieght Then BounceX() EndIf If x > GraphicsWindow.Width - 53 And x < GraphicsWindow.Width - 43 + 5 And y > y2 And y < y2 + PaddHieght Then BounceX() EndIf If x > 95 And x < 105 + 5 And y > y2 And y < y2 + PaddHieght Then BounceX() EndIf If x < 25 And y < 75 Then BounceX() EndIf If x < 25 And y > GraphicsWindow.Height - 75 Then BounceX() EndIf If x > GraphicsWindow.Width - 36 And y > GraphicsWindow.Height - 75 Then BounceX() EndIf If x > GraphicsWindow.Width - 36 And y < 75 Then BounceX() EndIf If y > GraphicsWindow.Height - 31 Or y < 20 Then BounceY() EndIf EndWhile Sub OnKeyDown If GraphicsWindow.LastKey = "W" Then Dy1 = -speed ElseIf GraphicsWindow.LastKey = "S" Then Dy1 = speed ElseIf GraphicsWindow.LastKey = "Up" Then Dy2 = -speed ElseIf GraphicsWindow.LastKey = "Down" Then Dy2 = speed EndIf EndSub Sub OnKeyUp If GraphicsWindow.LastKey = "W" Then Dy1 = 0 ElseIf GraphicsWindow.LastKey = "S" Then Dy1 = 0 ElseIf GraphicsWindow.LastKey = "Up" Then Dy2 = 0 ElseIf GraphicsWindow.LastKey = "Down" Then Dy2 = 0 EndIf EndSub Sub CheckReset If y1 > GraphicsWindow.Height - PaddHieght Then y1 = 0 EndIf If y2 > GraphicsWindow.Height - PaddHieght Then y2 = 0 EndIf If y1 < 0 Then y1 = GraphicsWindow.Height - PaddHieght EndIf If y2 < 0 Then y2 = GraphicsWindow.Height - PaddHieght EndIf EndSub Sub CheckBounce If y1 > (GraphicsWindow.Height - PaddHieght) - 20 Then Dy1 = 0 y1 = (GraphicsWindow.Height - PaddHieght) - 20 EndIf If y2 > (GraphicsWindow.Height - PaddHieght) - 20 Then Dy2 = 0 y2 = (GraphicsWindow.Height - PaddHieght) - 20 EndIf If y1 < 20 Then Dy1 = 0 y1 = 20 EndIf If y2 < 20 Then Dy2 = 0 y2 = 20 EndIf EndSub Sub BounceX dx = - dx x = x + (dx * 2) EndSub Sub BounceY dy = - dy y = y + (dy * 2) EndSub End>QPZ194.sb< Start>QQF794.sb< _nln=Text.GetCharacter(13)+Text.GetCharacter(10) dbg="False" _hexx="123456789ABCDEF LDDialogs.Wait("Turtle commander V1.1"+_nln +"(p)2015 by SB community","Green") Program.Delay(1500) LDDialogs.EndWait () dmt="0=Add/Chng...;1=Diamond;2=MultiDiamnds;3=Lace;4=Spyrall;5=Star5;6=HyperLoop;7=HypFlwrGrid;8=Flwr5;9=Flwr4;10=Clock dmm=11 vcnt=0 scnt=0 smd=0 rec=0 deff[1]="{10!S 0!R 108!{5 !R 72!F 80!}!## deff[2]="{5!S 0!{10!R 108!{5 !R 72!F 80!}!}!//!R 144!U!F 210!D!## deff[3]="{25!S 0!F 30!{3 !R 95!F 140!}!## deff[4]="{95!S 1.025!R 91.5!F 40!## deff[5]="{5!R 144!F 140!## deff[6]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!//!$!R 90!{55 !R 91.5!F 40!S/1.025!}!//!&!L 90!{55 !R 91.5!F 40!S/1.025!}!//!&!R 90!{55 !L 91.5!F 40!S/1.025!}!## deff[7]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!//!$!R 90!{55 !R 91.5!F 40!S/1.025!}!//!&!L 90!{55 !R 91.5!F 40!S/1.025!}!//!&!R 90!{55 !L 91.5!F 40!S/1.025!}!//!&!{55 !L 91.5!F 40!S/1.025!}!//!&!{55 !R 91.5!F 40!S/1.025!}!//!&!R 180!{55 !R 91.5!F 40!S/1.025!}!//!&!R 180!{55 !L 91.5!F 40!S/1.025!}!## deff[8]="{5!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.93!}!## deff[9]="{4!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.76!}!## deff[10]="{1!D!R 130!{72 !F 11!R 5!}!|V2=1!U!R 140!F 33!L 136!{12 !WRT %1!F 55!R 30!|V2+1!}!R 72!F 20!D!F 100!R 45!F 60!## _TFL="0=False;1=True;2=True" stpp=0 Init() LDDialogs.AddRightClickMenu(dmt,"") LDDialogs.RightClickMenu=rmm return=0 args=0 GraphicsWindow.MouseDown=mdd 'GraphicsWindow.MouseMove=mww GraphicsWindow.MouseUp=muu Main() Sub domsg mtxx="Turtle commander V1.1"+_nln +"(p)2015 by SB community" If Text.StartsWith(args[1],"$") Then mtxx=text.GetSubTextToEnd(args[1],2) Endif LDDialogs.Wait(mtxx,"Green") Program.Delay(1500) LDDialogs.EndWait () EndSub Sub muu nxt=1 endsub Sub cang ox= Turtle.X oy= Turtle.Y nx= GraphicsWindow. Mousex ny= GraphicsWindow. Mousey ta= Turtle.Angle aag= 0'mathplus.GetDegrees ( MathPlus.ATan2(nx-ox,ny-oy)+Math.Pi/2) -ta If aag>180 Then aag=aag-360 elseIf aag<-180 Then aag=aag+360 endif aag=math.Round(aag) endsub Sub mww If rec=1 Then cang() GraphicsWindow.Title = aag+" | old:"+Turtle.angle endif EndSub Sub mdd If mov=1 Then Turtle.x= GraphicsWindow.MouseX Turtle.y=GraphicsWindow.MouseY mov=0 elseif rec=1 and nxt=1 Then nxt=0 'cang() ota=turtle.angle Turtle.Angle=Turtle.Angle+aag If Turtle.Angle>180 then Turtle.Angle=Turtle.Angle-360 elseif Turtle.Angle<-180 then Turtle.Angle=Turtle.Angle+360 endif nta=turtle.angle dta=nta-ota dst=0' Math.SquareRoot ( ESLMaths.Square (GraphicsWindow.MouseX - Turtle.x)+ESLMaths.Square (GraphicsWindow.Mousey - Turtle.y)) dst=math.Round (dst) Turtle.Move (dst) dd="R " If dta<0 then dd="L " endif 'TextWindow.WriteLine (aag) 'Clipboard.SetText(cr+dd+Math.Abs(dta)+cr+"F "+dst) LDFocus.SetFocus(pgm) ' aw = SPExtra.SendKeys("+{INS}") EndIf EndSub Sub findvar ar=Text.ConvertToUpperCase(args[1]) For ax=1 To vcnt If Text.ConvertToUpperCase(mem[ax][0])=ar Then return=ax Goto xxx endif EndFor TextWindow.WriteLine (ar+" VAR-notfnd!") return="!VARnotfnd!" xxx: endsub Sub rmm dd= LDDialogs.LastRightClickMenuItem if dd>0 Then LDControls .RichTextBoxSetText(pgm, LDText.Replace ( deff[dd],"!",_nln ),"False") Else rr=LDDialogs.Confirm("YES-save NO-load CANC=add","Menu Action:" ) If rr="Yes" Then ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("d:\defs.txt",deff) ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("d:\defm.txt",dmt) LDCall.Function ("DoMsg","$Saved ok.") elseIf rr="No" Then ' The following line could be harmful and has been automatically commented. ' deff=File.ReadContents ("d:\defs.txt") ' The following line could be harmful and has been automatically commented. ' dmt=File.ReadContents ("d:\defm.txt") LDCall.Function ("DoMsg","$Load ok.") LDDialogs.AddRightClickMenu(dmt,"") else li= LDText.Split (src,CR) att="" For t=1 To Array.GetItemCount (li) att=att+li[t]+"!" endfor tree=LDControls.TreeViewGetData(trr) deff[dmm]= att dmt[dmm]=tree[12][11] dmm=dmm+1 LDDialogs.AddRightClickMenu(dmt,"") endif EndIf EndSub Sub hshow txx= LDText.Split("FWD!BCK!<<>>!LOOP!VAR!CNST!SUB!FOR!GRID!Rec!MvTo!IF!EDIT!OPEN!NEW","!") For x=1 To 16 bb[x]= Controls.AddButton(txx[x], 2, 5+(x-1)*40) EndFor EndSub Sub Main nwwp: nww=0 tree="" tree[1][0]="Main" tree[2][1]="Defs tree[3][2]="Heading tree[4][3]="0 tree[5][2]="Bgrnd tree[6][5]="#bbccdd tree[7][2]="ForeClr tree[8][7]="AUTO tree[9][2]="Width tree[10][9]="4 tree[11][1]="Con/Vars tree[12][11]="0 tree[13][1]="Subs/Lps mem=0 sbb=0 Goto rr2 rrr: GraphicsWindow.BackgroundColor =bcll rr2: nxt=1 _inn=0 GraphicsWindow.Clear() Turtle.Show() GraphicsWindow.PenWidth=4 Turtle.PenUp () Turtle.MoveTo (600,400) Turtle.PenDown () GraphicsWindow.FontName="Calibri" GraphicsWindow.FontSize=14 hshow() ch=0 _l=1 sc=1 _sbc=0 GraphicsWindow.BrushColor = "DimGray" LDControls.RichTextBoxFontFamily="Lucida Console" LDControls .RichTextBoxFontSize = 18 trr=LDControls.AddTreeView(tree,180,350) nset() Controls.Move (trr,50,gh-355) pgm = ldControls.AddRichTextBox (10, 10) Controls.SetSize(pgm, 180, gh - 360) Controls.Move (pgm,50,1) ldControls.RichTextBoxSetText (pgm, src,"False") LDControls.RichTextBoxDefault(pgm) GraphicsWindow.BrushColor = "Black" g=gh-36 c1= Controls.AddButton("RUN", 2, g) g=g-35 c2=Controls.AddButton("CLR", 2, g) g=g-35 c3=Controls.AddButton("XPlain", 2, g) g=g-35 c4=Controls.AddButton("Paste", 2, g) g=g-35 c5=Controls.AddButton("? hlp", 2, g) g=g-35 c6=Controls.AddButton("DrwCh", 2, g) clicked = "False" Controls.ButtonClicked = OnButtonClicked GraphicsWindow.PenColor = "DimGray" Turtle.Show() Turtle.PenUp() Turtle.MoveTo (700,400) Turtle.PenDown() Turtle.Angle=0 GraphicsWindow.FontName = "Lucida Console" GraphicsWindow.FontSize =12 While "True" If rst=1 Then src = LDControls .RichTextBoxGetText (pgm) tree=LDControls.TreeViewGetData(trr) bcll =tree[6][5] rst=0 If nww=1 then Goto nwwp else Goto rrr endif elseIf clicked Then Controls.SetButtonCaption(c1,"STOP") clicked = "False" src = LDControls .RichTextBoxGetText(pgm) If Text.GetSubText(src,1,1)="{" or Text.GetSubText(src,1,1)="#" then If Text.GetSubText(src,1,1)="#" then dbg="True" Else dbg="False" endif line= LDText.Split (src,_nln ) rrw= ( text.GetSubTextToEnd(line[1],2))'tonum! nLines =Array.GetItemCount (line) If dbg then TextWindow.WriteLine (">>>>>>>>>>>>>>>>>>>>>runn>>>>>>>>>>>>>>>>>>") endif GraphicsWindow.Title="Run mode..." tree=LDControls.TreeViewGetData(trr) 'TextWindow.WriteLine(tree) GraphicsWindow.PenWidth=tree[10][9] 'GraphicsWindow.Title=rrw tree=LDControls.TreeViewGetData(trr) Turtle.Angle =tree[4][3] sbscan() For tt=1 To rrw vcnt=0 scnt=0 'TextWindow.WriteLine (line) For i = 2 To rwx linee=line[i] If Text.StartsWith(linee,"##") then Goto finn elseif Text.StartsWith(linee,"<") then smd=1 elseif Text.StartsWith(linee,">") then smd=0 ElseIf smd=0 and stpp=0 then DoLine() endif If stpp=1 then Controls.SetButtonCaption(c1,"RUN") stpp=0 GraphicsWindow.Title="Stopped." clicked="False Goto wwh endif EndFor finn: EndFor tree[4][3]=math.Round (math.Remainder (Turtle.Angle,360)) LDControls.TreeViewContent(trr,tree) nset() Controls.SetButtonCaption(c1,"RUN") GraphicsWindow.Title="Done." EndIf Else EndIf wwh: EndWhile EndSub Sub sbscan c=1 rwx=nLines While Text.StartsWith (line[c],"##")<>"True c=c+1 If c>nLines then TextWindow.WriteLine("No ##") goto tt endif EndWhile rwx=c-1 For i=c To nLines If Text.StartsWith(line[i], "<") Then _sbc=_sbc+1 smd=1 sbb[_sbc]["Stt"] = i + 1 For k = i+1 To nLines If Text.StartsWith(line[k], ">") Then sbb[_sbc]["End"] = k-1 smd=0 endif endfor tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 If dbg then typ="Sb" sbb[_sbc][0]=Text.GetSubTextToEnd (linee, 2) tree[nc][13]=typ+":"+_sbc+">"+sbb[_sbc]["Stt"]+" to "+sbb[_sbc]["End"] LDControls.TreeViewContent(trr,tree) nset() endif endif endfor tt: Endsub Sub nset LDControls.TreeViewExpand(trr,0,"True","True") nn= LDText.Split("4,6,8,10,12",",") For x=1 To Array.GetItemCount(nn) LDControls.TreeViewEdit(trr,nn[x],"True") endfor EndSub Sub drwgrd GraphicsWindow.PenWidth=1 GraphicsWindow.PenColor="#aaaaaa For x=1 To 70 GraphicsWindow.DrawLine(220+x*20,0,220+x*20,800) EndFor For x=1 To 40 GraphicsWindow.DrawLine(220,x*20,1400,x*20) EndFor EndSub Sub xplain TextWindow.Show () TextWindow.Clear() idd=" " src = LDControls .RichTextBoxGetText (pgm) TextWindow.WriteLine("Explain program dump list"+_nln ) line= LDText.Split (Text.ConvertToUpperCase(src),_nln ) rrw= ( text.GetSubTextToEnd(line[1],2))'ToNumber nLines =Array.GetItemCount (line) TextWindow.WriteLine ("{Main loop, repeating times:"+rrw) For i=2 To nLines linee=line[i] If Text.StartsWith(linee,"##") then TextWindow.WriteLine ("} Main loop end.*******************") else xpline() endif EndFor endsub Sub OnButtonClicked '"FWD!BCK!<<>>!LOOP!VAR!CNST!sub!FOR!SUB!SAVE!LOAD!IF!HLP!NEW" clb=Controls.LastClickedButton If clb=c2 then rst=1 elseIf clb=c3 then xplain () elseIf clb=c4 then LDControls.RichTextBoxSetText(pgm,Src,"False") rst=1 elseif clb=bb[1] then LDControls.RichTextBoxSetText(pgm,"F ","True") elseif clb=bb[2] then LDControls.RichTextBoxSetText(pgm,"R 180"+cr+"F "+cr+"R 180","True") elseif clb=bb[3] then LDControls.RichTextBoxSetText(pgm,"L ","True") elseif clb=bb[4] then LDControls.RichTextBoxSetText(pgm,"R ","True") elseif clb=bb[5] then LDControls.RichTextBoxSetText(pgm,"{1 "+cr+"}","True") elseif clb=bb[6] then LDControls.RichTextBoxSetText(pgm,"|v1=1","True") elseif clb=bb[7] then LDControls.RichTextBoxSetText(pgm,"%1","True") elseif clb=bb[8] then ctx=(cr+""+cr) LDControls.RichTextBoxSetText(pgm,ctx,"True") elseif clb=bb[9] then ctx=(cr+"|f1~1"+cr+"FOR %1;10;+1 ["+cr+"]"+cr) LDControls.RichTextBoxSetText(pgm,ctx,"True") elseif clb=bb[10] then DrwGrd() elseif clb=bb[11] then elseif clb=bb[12] then mov=1 elseif clb=bb[13] then ctx=(cr+"{IF =%1;n;2 "+cr+"//True"+cr+":$2 "+cr+"//False"+cr) LDControls.RichTextBoxSetText(pgm,ctx,"True") elseif clb=bb[14] then Controls.SetSize(pgm,800, gh - 360) elseif clb=bb[15] then fnm=LDDialogs.OpenFile("txt","i:\txt") ' The following line could be harmful and has been automatically commented. ' If ldFile.Exists(fnm) then ' The following line could be harmful and has been automatically commented. ' fcc=File.ReadContents(fnm) LDControls.RichTextBoxSetText(pgm,fcc,"False") endif elseif clb=c5 then Helpp() elseif clb=c6 then tree=LDControls.TreeViewGetData(trr) cch=tree[12][11] If text.GetCharacterCode (cch)>32 then GraphicsWindow.FontName="Times New Roman" GraphicsWindow.FontSize=540 GraphicsWindow.FontBold="True GraphicsWindow.FontItalic="True GraphicsWindow.BrushColor="#bbbbbb GraphicsWindow.DrawText(300,150,cch) endif elseif clb=bb[16] then rst=1 nww=1 src="{1"+cr LDControls .RichTextBoxSetText (pgm, src,"False") else clicked = "True" endif EndSub Sub DoLine '----------------------------------------------LINEPROC----------------------------- linee= LDText.Trim (linee) If linee="" Or Text.StartsWith(linee,"//") Then Goto exx endif If tree[8][7]="AUTO" Then GraphicsWindow.PenColor=LDColours.HSLtoRGB(math.Remainder (ch,360) ,0.9,0.4) Else GraphicsWindow.PenColor=tree[8][7] endif ch=ch+1 While Text.IsSubText(linee,"%") dorepl() endwhile ree: If Text.StartsWith(linee, Text.GetCharacter (34)) Then 'virtual mode If _inn>0 Then linee=text.GetSubTextToEnd (linee,2) Goto ree Endif elseIf Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then vcnt=vcnt+1 mem[vcnt][1]=vv mem[vcnt][0]=vn elseif dfc="'" then rr=ldcall.Function("findvar",vn) mem[rr][1]=text.GetCharacter (vv) elseif dfc="." then pp= (text.GetSubText(linee,5,2))'mathplus.ToNumber scnt=scnt+1 Matr[scnt]=Text.GetSubTextToEnd ( vv,4) elseif dfc=";" then For scnt=1 to Text.GetLength (vv) Matr[scnt]=Text.GetSubText(vv,scnt,1) endfor elseif dfc="+" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]+vv elseif dfc="~" then rr=ldcall.Function("findvar",vn) mem[rr][1]=vv elseif dfc="*" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]*vv elseif dfc="/" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]/vv endif ElseIf Text.StartsWith(linee, "~B#") Then 'block wdth tww= Text.GetSubTextToEnd (linee,4) ElseIf Text.StartsWith(linee, "WB#") Then 'block txt ttx= Text.GetSubTextToEnd (linee,4) GraphicsWindow.DrawBoundText(Turtle.x, Turtle.y,tww,ttx) ElseIf Text.StartsWith(linee, "#O>") Then 'obj mode objm=1 oo=1 Program.Delay(5) obj[oo][1]=Turtle.X obj[oo][2]=Turtle.Y oo=oo+1 ElseIf Text.StartsWith(linee, "#O#") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,4) objm=0 opp[ttx]=LDShapes.AddPolygon (obj) LDShapes.BrushColour(opp[ttx],GraphicsWindow.PenColor) ElseIf Text.StartsWith(linee, "#OM") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,5) ttt= LDText.Split (ttx,";") Shapes.Move (opp[ttt[3]],ttt[1]-obj[1][1],ttt[2]-obj[1][2]) ElseIf Text.StartsWith(linee, "#OA") Then 'obj mode ttx= Text.GetSubTextToEnd (linee,5) ttt= LDText.Split (ttx,";") Shapes.Animate (opp[ttt[3]],ttt[1]-obj[1][1],ttt[2]-obj[1][2],ttt[4]) ElseIf Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif TextWindow.WriteLine(">:"+ttx) ElseIf Text.StartsWith(linee, "WRT") Then ttx= Text.GetSubTextToEnd (linee,5) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif GraphicsWindow.DrawText(Turtle.x, Turtle.y, ttx) elseif Text.StartsWith(linee, "F") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) if objm=1 then obj[oo][1]=Turtle.X obj[oo][2]=Turtle.Y oo=oo+1 endif 'GraphicsWindow.Title="Dst:"+math.Round ( dist*sc) if dbg then TextWindow.WriteLine(math.Floor (dist*sc)) endif Elseif Text.StartsWith(linee, "S") Then If Text.GetSubText(linee,2,1)="/" then sc=sc/ Text.GetSubTextToEnd(linee, 3) else sc=sc* Text.GetSubTextToEnd(linee, 3) endif If sc=0 then sc=1 EndIf ElseIf Text.StartsWith(linee, "$") Then tx=Turtle.x ty=Turtle.Y ta= Turtle.Angle ts=sc ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) Sst= sbb[scc]["Stt"] sen=sbb[scc]["End"] Stack.PushValue("locali", i) Stack.PushValue("localj", j) For i = sSt To sEn linee=line[i] _inn=_inn+1 DoLine() _inn=_inn-1 Endfor i = Stack.PopValue("locali")+1 j=Stack.PopValue("localj") ElseIf Text.StartsWith(linee, "&") Then Turtle.x=tx Turtle.Y=ty Turtle.Angle=ta sc=ts ElseIf Text.StartsWith(linee, "#X") Then 'FCExtensions.Eval(Text.GetSubTextToEnd(linee, 4)) ElseIf Text.StartsWith(linee, "#E") Then ' mem[1][1]=FCExtensions.MathEval(Text.GetSubTextToEnd(linee, 4)) ElseIf Text.StartsWith(linee, "#F") Then ff=Text.GetSubTextToEnd(linee, 4) fn=LDText.Split(ff,";") GraphicsWindow.FontName=fn[1] GraphicsWindow.FontBold=_tfl[fn[2]] GraphicsWindow.FontItalic=_tfl[fn[3]] GraphicsWindow.FontSize=fn[4] ElseIf Text.StartsWith(linee, "#P") Then GraphicsWindow.BrushColor=GraphicsWindow.PenColor ElseIf Text.StartsWith(linee, "~S") Then LDQueue.Enqueue("q1",Turtle.x+":"+Turtle.y) ElseIf Text.StartsWith(linee, "~G") Then tp=LDQueue.Dequeue ("q1") tt=LDText.Split(tp,":") Turtle.x=tt[1] Turtle.y=tt[2] ElseIf Text.StartsWith(linee, "#C") Then ww = ( Text.GetSubTextToEnd(linee, 4))'tonum GraphicsWindow.BrushColor=GraphicsWindow.PenColor If ww=0 then ww=5 endif GraphicsWindow.FillEllipse(Turtle.x-ww, Turtle.y-ww,ww*2,ww*2) ElseIf Text.StartsWith(linee, "XC") Then ww = ( Text.GetSubTextToEnd(linee, 4))'tonum GraphicsWindow.BrushColor=GraphicsWindow.BackgroundColor If ww=0 then ww=5 endif GraphicsWindow.FillEllipse(Turtle.x-ww, Turtle.y-ww,ww*2,ww*2) ElseIf Text.StartsWith(linee, "`C") Then ww = Text.GetSubTextToEnd(linee, 3) GraphicsWindow.BrushColor=ww ElseIf Text.StartsWith(linee, "~H") Then Turtle.x=600 Turtle.Y=400 Turtle.Angle=0 ElseIf Text.StartsWith(linee, "P") Then GraphicsWindow.PenColor=GraphicsWindow.BackgroundColor GraphicsWindow.PenWidth=GraphicsWindow.PenWidth+2 distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) GraphicsWindow.PenWidth=GraphicsWindow.PenWidth-2 ElseIf Text.StartsWith(linee, "~FN") Then GraphicsWindow.FontName=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~FS") Then GraphicsWindow.FontSize=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~C") Then ccl=GraphicsWindow.BrushColor GraphicsWindow.BrushColor =GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle (220,200,800,400) GraphicsWindow.BrushColor=ccl ElseIf Text.StartsWith(linee, "~T") Then mem[1][1]=Clock.Hour mem[1][0]="_H" mem[2][1]=Clock.Minute mem[2][0]="_M mem[3][1]=Clock.Second mem[3][0]="_S mem[4][1]=Clock.Date mem[4][0]="_D" ElseIf Text.StartsWith(linee, "~") Then Program.Delay (Text.GetSubTextToEnd(linee, 2)) ElseIf Text.StartsWith(linee, "U") Then Turtle.PenUp() ElseIf Text.StartsWith(linee, "D") Then Turtle.PenDown() ElseIf Text.StartsWith(linee, "R") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(dist) ElseIf Text.StartsWith(linee, "L") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(-dist) ElseIf Text.StartsWith(linee, "A") Then distance = -Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Angle=dist ElseIf Text.StartsWith(linee, ":$") Then icc=Text.GetSubTextToEnd (linee, 3) i=i+icc ElseIf Text.StartsWith(linee, "IF") Then icc=Text.GetSubTextToEnd (linee, 4) iif= LDText.Split(icc,";") v1=iif[1] v2=iif[2] If iif[3]=0 then skp=2 Else skp=iif[3] endif cond=0 TextWindow.WriteLine ("Sk:"+Skp) If Text.StartsWith(icc,"=") then If v1=v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,">") then If v1v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,"!") then If v1<>v2 then cond=1 Else cond=2 endif endif If cond=0 then TextWindow.WriteLine ("IF invalid cond error!") else if cond=1 then 'true part TextWindow.WriteLine ("TRue") Else 'false part TextWindow.WriteLine ("Flss") i=i+skp endif endif ElseIf Text.StartsWith(linee, "{") Then count[_l] = ( Text.GetSubTextToEnd (linee, 2))'tonum iStart[_l] = i + 1 iEnd[_l] = nLines nest = 0 tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 For k = iStart[_l] To nLines 'TextWindow.WriteLine(">>"+k) If Text.StartsWith(line[k], "{") Then nest = nest + 1 ElseIf Text.StartsWith(line[k], "]") or Text.StartsWith(line[k], "}") Then If nest = 0 Then iEnd[_l] = k - 1 k= nLines Else nest = nest - 1 EndIf EndIf EndFor If dbg then typ="Lp" tree[nc][13]=typ+":"+nest+">"+iStart[_l]+" to "+iEnd[_l] LDControls.TreeViewContent(trr,tree) nset() endif j = count[_l] _l = _l + 1 While j>0 Stack.PushValue("local", j) _inn=_inn+1 For i = iStart[_l - 1] To iEnd[_l - 1] linee=line[i] If Text.IsSubText (linee,"%$$") Then linee=LDText.Replace (linee,"%$$",j) elseIf Text.IsSubText (linee,"%$A") Then linee=LDText.Replace (linee,"%$A",Turtle.Angle ) elseIf Text.IsSubText (linee,"%$C") Then linee=LDText.Replace (linee,"%$C",GraphicsWindow.PenColor ) elseIf Text.IsSubText (linee,"%$") Then linee=LDText.Replace (linee,"%$","%"+ text.GetSubText (_hexx,j,1) ) endif If dbg then TextWindow.WriteLine (i+">>"+linee) endif DoLine() EndFor _inn=_inn-1 j = Stack.PopValue("local")-1 Endwhile _l = _l - 1 i = iEnd[_l] + 2 EndIf exx: EndSub Sub dorepl If Text.IsSubText (linee,"%") Then aq="!! If Text.IsSubText(linee,aq) Then m2=Text.Append("0", mem[2][1]) m2=Text.GetSubTextToEnd (m2,text.GetLength( mem[2][1])) m3=Text.Append("0", mem[3][1]) m3=Text.GetSubTextToEnd (m3,text.GetLength( mem[3][1])) endif If Text.IsSubText (linee,"%1") Then linee=LDText.Replace (linee,"%1",mem[1][1]) elseIf Text.IsSubText (linee,"%2"+aq) Then linee=LDText.Replace (linee,"%2"+aq,m2) elseIf Text.IsSubText (linee,"%3"+aq) Then linee=LDText.Replace (linee,"%3"+aq,m3) elseIf Text.IsSubText (linee,"%2") Then linee=LDText.Replace (linee,"%2",mem[2][1]) elseIf Text.IsSubText (linee,"%3") Then linee=LDText.Replace (linee,"%3",mem[3][1]) elseIf Text.IsSubText (linee,"%4") Then linee=LDText.Replace (linee,"%4",mem[4][1]) elseIf Text.IsSubText (linee,"%5") Then linee=LDText.Replace (linee,"%5",mem[5][1]) elseIf Text.IsSubText (linee,"%6") Then linee=LDText.Replace (linee,"%6",mem[6][1]) elseIf Text.IsSubText (linee,"%7") Then linee=LDText.Replace (linee,"%7",mem[7][1]) elseIf Text.IsSubText (linee,"%8") Then linee=LDText.Replace (linee,"%8",mem[8][1]) elseIf Text.IsSubText (linee,"%9") Then linee=LDText.Replace (linee,"%9",mem[9][1]) elseIf Text.IsSubText (linee,"%A") Then linee=LDText.Replace (linee,"%A",mem[10][1]) elseIf Text.IsSubText (linee,"%B") Then linee=LDText.Replace (linee,"%B",mem[11][1]) elseIf Text.IsSubText (linee,"%C") Then linee=LDText.Replace (linee,"%C",mem[12][1]) elseIf Text.IsSubText (linee,"%D") Then linee=LDText.Replace (linee,"%D",mem[13][1]) elseIf Text.IsSubText (linee,"%E") Then linee=LDText.Replace (linee,"%E",mem[14][1]) elseIf Text.IsSubText (linee,"%F") Then linee=LDText.Replace (linee,"%F",mem[15][1]) elseIf Text.IsSubText (linee,"%M") Then mm=text.GetSubTextToEnd(linee,text.GetIndexOf(linee,".")+1) linee=LDText.Replace (linee,"%M."+mm,matr[(mm)]) elseIf Text.IsSubText (linee,"%X") Then linee=LDText.Replace (linee,"%X",math.Round (Turtle.x)) elseIf Text.IsSubText (linee,"%Y") Then linee=LDText.Replace (linee,"%Y",math.Round (Turtle.y)) elseIf Text.IsSubText (linee,"%W") Then linee=LDText.Replace (linee,"%W",math.Remainder (Turtle.Angle,360) ) endif endif endsub Sub fWriteLn TextWindow.WriteLine(idd+args[1]) EndSub Sub xpline '**************************************xplains prg....********************* If Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then LDCall.Function("fWriteLn","Define New VAR "+vn+" and assign value:"+vv) vcnt=vcnt+1 mem[vcnt][0]=vn elseif dfc="+" then LDCall.Function("fWriteLn","Increase VAR "+vn+" by:"+vv) elseif dfc="~" then LDCall.Function("fWriteLn","Find VAR "+vn+" and assign value:"+vv) elseif dfc="*" then LDCall.Function("fWriteLn","Multiply VAR "+vn+" by:"+vv) elseif dfc="/" then LDCall.Function("fWriteLn","Divide VAR "+vn+" by:"+vv) endif endif If Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) LDCall.Function("fWriteLn","Write to console:"+ttx) ElseIf Text.StartsWith(linee, "%") then LDCall.Function("fWriteLn","Perform "+Text.GetSubTextToEnd (linee,4)) ElseIf Text.StartsWith(linee, "WRT") Then 'turtle writting ttx= Text.GetSubTextToEnd (linee,5) LDCall.Function("fWriteLn","Write to screen:"+ttx) ElseIf Text.StartsWith(linee, "Ht") Then LDCall.Function("fWriteLn","Reset to Home pos.") elseif Text.StartsWith(linee, "F") Then dist = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(dist,"%") then dist = "var value:"+mem[Text.GetIndexOf (_hexx, Text.GetSubTextToEnd(dist, 2))][0] endif LDCall.Function("fWriteLn","Forward by:"+ dist) Elseif Text.StartsWith(linee, "<") Then ttx= Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","") Then idd=text.GetSubTextToEnd(idd,3) LDCall.Function("fWriteLn",">END SUB.") Elseif Text.StartsWith(linee, "]") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","] END Repeat block") Elseif Text.StartsWith(linee, "}") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","} END block") Elseif Text.StartsWith(linee, "S") Then If sc=0 then sc=1 LDCall.Function("fWriteLn","Set scale to 1") else If Text.GetSubText(linee,2,1)="%" then LDCall.Function("fWriteLn","Alter scale <(kind +/*) selected by VAR:"+mem[Text.GetIndexOf (_hexx, Text.GetSubText(linee, 3,1))][0]+"> by factor:"+Text.GetSubTextToEnd(linee, 5)) elseIf Text.GetSubText(linee,2,1)="/" then LDCall.Function("fWriteLn","Divide scale by:"+Text.GetSubTextToEnd(linee, 3)) else LDCall.Function("fWriteLn","Multiply scale by:"+Text.GetSubTextToEnd(linee, 3)) endif EndIf ElseIf Text.StartsWith(linee, "$") Then LDCall.Function("fWriteLn","Save turtle pos.") ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","Call sub:"+sbb[scc][0]) ElseIf Text.StartsWith(linee, "&") Then LDCall.Function("fWriteLn","Restore turtle pos.") ElseIf Text.StartsWith(linee, "U") Then LDCall.Function("fWriteLn","Pen UP - moving") ElseIf Text.StartsWith(linee, "D") Then LDCall.Function("fWriteLn","Pen DN - drawing") ElseIf Text.StartsWith(linee, "R") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn RIGHT by:"+dist) ElseIf Text.StartsWith(linee, "L") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn LEFT by:"+dist) ElseIf Text.StartsWith(linee, "{") Then LDCall.Function("fWriteLn","{Repeat block times:"+Text.GetSubTextToEnd(linee,2)) idd=idd+" " EndIf EndSub'---------------------------------xplain********************** Sub Init gw = 1000 gh = 900 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Turtle Graphics GraphicsWindow.BackgroundColor="#bbccdd GraphicsWindow.Top=0 GraphicsWindow.Left=0 Turtle.Speed=10 CR = _nln src=LDText.Replace ( deff[8],"!",_nln ) EndSub Sub Helpp txx="Spec.vars :"+_nln txx=txx+">only shows :"+_nln txx=txx+"%$$ = loop counter backward"+_nln txx=txx+"%$A = Turtle.Angle"+_nln txx=txx+"%$C = Pen color"+_nln txx=txx+"%$n = n=[ 1..F(hex)] ref. in loop to vars 1..15"+_nln txx=txx+_nln+"Spec.cmds:"+_nln txx=txx+"%M.nn= matrix row nn _1..99"+_nln txx=txx+"|vv;txt <= stores txt as chars in matrix %M"+_nln txx=txx+"|vv~nnn <= stores data in existing var vv"+_nln txx=txx+"|vv=nnn <= stores data in new var vv"+_nln txx=txx+"|vv+nnn <= adds value to var vv"+_nln txx=txx+"|vv*nnn <= multipl. value to var vv"+_nln txx=txx+"|vv/nnn <= divides var vv by val."+_nln txx=txx+"|vv'cccc <= stores chr unicode cccc to var vv"+_nln txx=txx+"~n = delay n msecs"+_nln txx=txx+"#C ww = fill circle rad.ww px"+_nln txx=txx+"XC ww = del. circle rad.ww px"+_nln txx=txx+"~C = del. watch zone"+_nln txx=txx+"$ = save turtle loc."+_nln txx=txx+"& = restore turtle loc."+_nln txx=txx+"#F fnam;bld;itl;siz = set font name, bold 0 or 1, italic 0/1, size"+_nln txx=txx+"#P = set pen clr from treedef."+_nln txx=txx+"~H = Home turtle"+_nln txx=txx+"#E xpr = matheval xpr expression"+_nln txx=txx+"#X cmd = exec. sb cmd"+_nln GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Tahoma" GraphicsWindow.FontSize = 15 GraphicsWindow.PenColor="Black GraphicsWindow.DrawText(310, 20, "S ff | S/ff = scale") GraphicsWindow.DrawText(310, 40, "F dist=move forward") GraphicsWindow.DrawText(310, 60, "L|R angle = turn angle") GraphicsWindow.DrawText(310, 80, "D)wn | U)p = pen mode") GraphicsWindow.DrawText(310, 105, " sub end") GraphicsWindow.DrawText(310, 165, "@n = sub call n=1..maxnsub by def. order ") GraphicsWindow.DrawText(310, 190, "{count ") GraphicsWindow.DrawText(310, 210, "loop cmds ") GraphicsWindow.DrawText(310, 230, "] or } loop end") GraphicsWindow.DrawBoundText(310,250,350,txx) EndSub End>QQF794.sb< Start>QQF821.sb< dw=900 dh=dw GraphicsWindow.BackgroundColor ="Darkblue GraphicsWindow.Width = dw GraphicsWindow.Height = dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title ="3d globe T_x=0 T_y=-40 T_Angle=180 deg=44/7/360 view3D = LD3DView.AddView(dw,dh,"True") LD3DView.AddDirectionalLight(view3D,"Pink",-1,-1,-1) LD3DView.AddDirectionalLight(view3D,"DarkBlue",1,1,1) LD3DView.AddAmbientLight(view3D,"#50111111") LD3DView.ResetCamera(view3D,0,0,170, 0,0,-1,"","","") r9=7 For a=0 to 360 step 10 For i = -90 To 90 step 5 If i=0 then d=.2 else d = math.SquareRoot (Math.Abs( 1/i))/2 endif ss=LD3DView.AddSphere (view3D d 10 "white" "D") LD3DView.TranslateGeometry (view3D ss LDMath.Cos(a)*r9*ldmath.cos(i) ldmath.Sin(i)*r9 LDMath.sin(a)*r9*ldmath.cos(i)) EndFor endfor pn=LD3DView.AddCone (view3D .1 .1 16 20 "Red" "D") LD3DView.TranslateGeometry (view3D pn 0, -8 0) 'LD3DView.AutoControl("true" "true", -1 3) fk=2 While 1=1 For n=0 To 360 Step .2 deg=deg-1 x=ldMath.Sin(n)*17*fk z=ldmath.Cos(n)*17*fk LD3DView.ResetCamera(view3D,x,0,z,-x*5,20,-z*5,"","","") 'LD3DView.SetBillBoard (view3D pn) Program.Delay(10) EndFor EndWhile End>QQF821.sb< Start>QQH165.sb< 'The umbrella is stationary gw = 600 gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = GraphicsWindow.GetColorFromRGB(200,175,175) segments = 16 rad = gw/4 cx = gw/2 cy = gh/2 offset = 0 theta1 = 0 x1 = cx+rad*Math.Cos(theta1) y1 = cy+rad*Math.Sin(theta1) While ("True") offset = offset+1 For i = 1 To segments theta2 = theta1+2*Math.Pi/segments x2 = cx+rad*Math.Cos(theta2) y2 = cy+rad*Math.Sin(theta2) j = Math.Remainder(i+offset,segments) R = 50+Math.Abs((j/(segments-1)-0.5)*300) G = R/2 B = R/2 GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(R,G,B) GraphicsWindow.FillTriangle(cx,cy,x1,y1,x2,y2) GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(100,75,75) GraphicsWindow.DrawLine(cx,cy,x1,y1) GraphicsWindow.DrawLine(cx,cy,x2,y2) theta1 = theta2 x1 = x2 y1 = y2 EndFor Program.Delay(30) EndWhile End>QQH165.sb< Start>QQK823.sb< 'Window GraphicsWindow.Hide() GraphicsWindow.Width = 200 GraphicsWindow.Height = 200 GraphicsWindow.Left = (Desktop.Width - 200) / 2 GraphicsWindow.Top = 100 GraphicsWindow.CanResize = "false" GraphicsWindow.Title = "Window" 'Regular Triangle triangle = Shapes.AddTriangle(0, 0, 100, 33.33, 33.33, 100) Shapes.Rotate(triangle, 45) Shapes.Move(triangle, 100, 50) 'Show Window GraphicsWindow.Show() End>QQK823.sb< Start>QQL113.sb< GraphicsWindow.Width = 400 GraphicsWindow.Height = 300 GraphicsWindow.DrawText(20,10,"Your Name") firstname = Controls.AddTextBox(170,10) GraphicsWindow.DrawText(20,70,"Your Lover's Name") secondname = Controls.AddTextBox(170,70) percentage = Shapes.AddText("Love Percentage = 0%") Shapes.Move(percentage,20,150) btn = Controls.AddButton("Calculate",170,100) Controls.ButtonClicked = calculate Sub calculate first = Text.ConvertToUpperCase(Controls.GetTextBoxText(firstname)) firstlength = Text.GetLength(first) second = Text.ConvertToUpperCase(Controls.GetTextBoxText(secondname)) secondlength = Text.GetLength(second) lovecount = 0 For i = 1 To firstlength letter1 = Text.GetSubText(first,i,1) If letter1 = "L" Then lovecount = lovecount + 2 EndIf If letter1 = "O" Then lovecount = lovecount + 2 EndIf if letter1 = "V" Then lovecount = lovecount + 2 EndIf if letter1 = "E" Then lovecount = lovecount + 2 EndIf if letter1 = "Y" Then lovecount = lovecount + 3 EndIf if letter1 = "O" Then lovecount = lovecount + 1 EndIf if letter1 = "U" Then lovecount = lovecount + 3 EndIf if letter1 = "I" Then lovecount = lovecount + 1 EndIf if letter1 = "E" Then lovecount = lovecount + 0.5 EndIf if letter1 = "A" Then lovecount = lovecount + 0.8 EndIf EndFor For j = 1 To secondlength letter2 = Text.GetSubText(second,j,1) If letter2 = "L" Then lovecount = lovecount + 2 EndIf If letter2 = "O" Then lovecount = lovecount + 2 EndIf if letter2 = "V" Then lovecount = lovecount + 2 EndIf if letter2 = "E" Then lovecount = lovecount + 2 EndIf if letter2 = "Y" Then lovecount = lovecount + 3 EndIf if letter2 = "O" Then lovecount = lovecount + 1 EndIf if letter2 = "U" Then lovecount = lovecount + 3 EndIf if letter2 = "I" Then lovecount = lovecount + 1 EndIf if letter2 = "A" Then lovecount = lovecount + 0.8 EndIf if letter2 = "E" Then lovecount = lovecount + 0.5 EndIf EndFor amount = 0 if LoveCount > 0 Then amount = 5 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 2 Then amount = 10 - ((firstlength + secondlength) / 2) EndIf if LoveCount > 4 Then amount = 20 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 6 Then amount = 30 - ((firstlength + secondlength) / 2) EndIf if LoveCount > 8 Then amount = 40 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 10 Then amount = 50 - ((firstlength + secondlength) / 2) EndIf if LoveCount > 12 Then amount = 60 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 14 Then amount = 70 - ((firstlength + secondlength) / 2) EndIf if LoveCount > 16 Then amount = 80 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 18 Then amount = 90 - ((firstlength + secondlength) / 2) EndIf if LoveCount > 20 Then amount = 100 - ((firstlength + secondlength) / 2) EndIf If LoveCount > 22 Then amount = 110 - ((firstlength + secondlength) / 2) EndIf If firstlength = 0 Or secondlength = 0 Then amount = "Error" EndIf If amount < 0 Then amount = 0 EndIf If amount > 99 Then amount = 99 EndIf Shapes.SetText(percentage,"Love Percentage = "+amount+"%") EndSub End>QQL113.sb< Start>QQL718.sb< TextWindow.ForegroundColor="cyan" path = "c:\Documents and Settings\Minecraft\Dekstop\SBStories\" ext = ".txt" begin: TextWindow.Clear() TextWindow.WriteLine("Welcome to the Story Menu") TextWindow.WriteLine("") TextWindow.WriteLine("Type the number of what would you like to do.") TextWindow.WriteLine("") TextWindow.WriteLine("1. Start a new story") TextWindow.WriteLine("2. Load a story") TextWindow.WriteLine("3. Exit") q1: a1 = " a1 = TextWindow.ReadNumber() If a1 = 1 Then Goto newstory ElseIf a1 = 2 Then Goto loadstory Elseif a1 = 3 then TextWindow.WriteLine("Are you sure you want to exit? (Y or N)") q2: a2 = " a2 = TextWindow.Read() If a2 = ("Y") or a2 = ("y") Then Program.End() Elseif a2 = ("N") or a2 = ("n") Then Goto begin Else TextWindow.WriteLine("Invalid answer. Please enter another:") Goto q2 EndIf Else TextWindow.WriteLine("Invalid answer. Please enter another:") Goto q1 EndIf newstory: TextWindow.Clear() TextWindow.WriteLine("Welcome to a new story") TextWindow.WriteLine("") TextWindow.Write("Please enter your name: ") name = TextWindow.Read() TextWindow.Write("Please enter a season: ") season = TextWindow.Read() TextWindow.Write("Please enter a climate type (ex. cloudy): ") climate = TextWindow.Read() TextWindow.Write("Please enter a type of terrain (ex. jungle): ") tot = TextWindow.Read() TextWindow.Write("Please enter an adjective: ") adj1 = TextWindow.Read() TextWindow.Write("Please enter a noun: ") n1 = TextWindow.Read() TextWindow.Write("Please enter an adjective: ") adj2 = TextWindow.Read() TextWindow.Write("Please enter a noun: ") n2 = TextWindow.Read() TextWindow.Write("Please enter a random word/phrase: ") rndmphrase = TextWindow.Read() TextWindow.Write("Please enter a candy (ex. Skittles): ") candy = TextWindow.Read() TextWindow.Pause() TextWindow.Clear() TextWindow.WriteLine("Once upon a ti- No, that's too cheezy.") TextWindow.WriteLine(name+" and some friends decided to go camping in the middle of "+season+".") TextWindow.WriteLine("It was unusually "+climate+".") TextWindow.WriteLine("They thought it was just the "+tot+".") TextWindow.WriteLine("So they pitched their "+adj1+" tents and started a fire.") TextWindow.WriteLine("They heard a noise coming from the "+n1+". ") TextWindow.WriteLine("Out came a "+adj2+" llama and it barfed rainbows into "+name+"'s lap.") TextWindow.WriteLine("Then the "+adj2+" llama flew away on a "+n2+"!") TextWindow.WriteLine(name+" cried out, '"+rndmphrase+"! ") TextWindow.WriteLine("Then "+name+" turned into a "+adj2+" llama and burst into "+candy+".") TextWindow.WriteLine("The End") TextWindow.Pause() TextWindow.Clear() TextWindow.WriteLine(name+", did you enjoy reading your story?") TextWindow.WriteLine("") TextWindow.WriteLine("Would you like to save your story? (Y or N?") q3: a3 = " a3 = TextWindow.Read() If a3 = "Y" or "y" Then Goto savefile ElseIf a3 = "N" or "n" Then TextWindow.WriteLine("Press any key to go back to the Main Menu.") TextWindow.PauseWithoutMessage() Goto begin Else TextWindow.WriteLine("Invalid answer. Please enter another:") Goto q3 EndIf savefile: customstory[1] = "Once upon a ti- No, that's too cheezy. " customstory[2] = name+" and some friends decided to go camping in the middle of "+season+". " customstory[3] = "It was unusually "+climate+". " customstory[4] = "They thought it was just the "+tot+". " customstory[5] = "So they pitched their "+adj1+" tents and started a fire. " customstory[6] = "They heard a noise coming from the "+n1+". " customstory[7] = "Out came a "+adj2+" llama and it barfed rainbows into "+name+"'s lap. " customstory[8] = "Then the "+adj2+" llama flew away on a "+n2+"! " customstory[9] = name+" cried out, '"+ rndmphrase+"! " customstory[10] = "Then "+name+" turned into a "+adj2+" llama and burst into "+candy+". " customstory[11] = "The End" TextWindow.Clear() TextWindow.WriteLine("Please enter the desired filename for your story:") filename = TextWindow.Read() ' The following line could be harmful and has been automatically commented. ' File.CopyFile("", path+filename+ext) ' The following line could be harmful and has been automatically commented. ' File.WriteContents(path+filename+ext, customstory) TextWindow.WriteLine("Press any key to go back to the Main Menu.") TextWindow.PauseWithoutMessage() Goto begin loadstory: TextWindow.Clear() TextWindow.WriteLine("Please write the name of the file you wish to load.") TextWindow.WriteLine("") TextWindow.WriteLine("Note: The filename must match the name you saved the story as exactly") TextWindow.WriteLine("or load will be unsuccessful.") TextWindow.WriteLine("") loadname = TextWindow.Read() ' The following line could be harmful and has been automatically commented. ' loadedfile = File.ReadContents(path+loadname+ext) TextWindow.WriteLine(loadedfile) TextWindow.PauseWithoutMessage() Goto begin End>QQL718.sb< Start>QQN144.sb< option = "number=false;edge=True Init() InitAtoms() If option["edge"] Then InitEdges() EndIf InitVectors() scale = 272 / (1 - 1 / Math.SquareRoot(3)) / 4 for ff=1 to 10 DrawEdges() DrawAtoms() Program.Delay(10) key = "Down RotateAtoms() GraphicsWindow.Clear() Endfor for ff=1 to 120 DrawEdges() DrawAtoms() Program.Delay(10) key = "Right RotateAtoms() ccc[ff]=LDGraphicsWindow.Capture("" "false") Program.Delay(11) GraphicsWindow.Clear() Endfor GraphicsWindow.Clear() while 1=1 for ff=1 to 120 GraphicsWindow.DrawImage(ccc[ff] 0 5) Program.Delay(33) Endfor EndWhile Sub DrawAtoms ' insert sort for drawing order btree = "" branch = "l=0;r=0;" ' end btree[81] = branch ' start For j = 1 To nVector If indexV[j] <> 81 Then param = "" i = 81 param["name1"] = "v" + i param["name2"] = "v" + indexV[j] Vector_Comp() branch = btree[i] While (gt And (0 < branch["r"])) Or (lt And (0 < branch["l"])) If gt Then i = branch["r"] Else ' lt i = branch["l"] EndIf param["name1"] = "v" + i param["name2"] = "v" + indexV[j] Vector_Comp() branch = btree[i] EndWhile ' insert vj before vi (or end) If gt And (branch["r"] = 0) Then branch["r"] = indexV[j] ElseIf lt And (branch["l"] = 0) Then branch["l"] = indexV[j] EndIf btree[i] = branch _branch = "l=0;r=0;" btree[indexV[j]] = _branch EndIf EndFor ' draw atoms GetBTreeOrder() buf = buf + "drawing order" + LF For iOrder = 1 To nOrder entry = matrix["v" + order[iOrder]] values = entry["values"] p["x"] = values[1][1] p["y"] = values[2][1] p["z"] = values[3][1] Map() p = atom[order[iOrder]] e = p["element"] c = element[e]["color"] rate = 0.3 * (1 + values[3][1] / Math.SquareRoot(3)) Color_Blacken() GraphicsWindow.BrushColor = c size = element[e]["size"] / 8 GraphicsWindow.FillEllipse(x - size / 2, y - size / 2, size, size) ' GraphicsWindow.DrawText(x - dx, y - size * 0.3, order[iOrder]) EndFor EndSub Sub DrawEdges index = Array.GetAllIndices(edge) n = Array.GetItemCount(edge) For i = 1 To n e = edge[index[i]] _p = Text.GetIndexOf(e, ",") pc = ec[Text.GetSubText(e, 1, _p - 1)] GraphicsWindow.PenColor = pc _p = _p + 1 _h = Text.GetIndexOf(Text.GetSubTextToEnd(e, _p), "-") x1 = "" While 0 < _h v = Text.GetSubText(e, _p, _h - 1) entry = matrix["v" + v] values = entry["values"] p["x"] = values[1][1] p["y"] = values[2][1] p["z"] = values[3][1] Map() x2 = x y2 = y If x1 <> "" Then GraphicsWindow.DrawLine(x1, y1, x2, y2) EndIf x1 = x2 y1 = y2 _p = _p + _h _h = Text.GetIndexOf(Text.GetSubTextToEnd(e, _p), "-") EndWhile v = Text.GetSubTextToEnd(e, _p) entry = matrix["v" + v] values = entry["values"] p["x"] = values[1][1] p["y"] = values[2][1] p["z"] = values[3][1] Map() x2 = x y2 = y If x1 <> "" Then GraphicsWindow.DrawLine(x1, y1, x2, y2) EndIf EndFor EndSub Sub GetBTreeOrder index = Array.GetAllIndices(btree) nBTree = Array.GetItemCount(btree) order = "" done = "" nOrder = 0 i = 81 GetNext() EndSub Sub GetNext branch = btree[i] If 0 < branch["l"] Then Stack.PushValue("local", i) i = branch["l"] GetNext() i = Stack.PopValue("local") EndIf branch = btree[i] nOrder = nOrder + 1 order[nOrder] = i If 0 < branch["r"] Then Stack.PushValue("local", i) i = branch["r"] GetNext() i = Stack.PopValue("local") EndIf EndSub Sub Init LF = Text.GetCharacter(10) Not = "False=True;True=False GraphicsWindow.Title = "Methane Hydrate" c1=LDColours.HSLtoRGB(180 .8 .8) brr=LDShapes.BrushGradient("1="+c1+";2=teal;3=darkblue" "DD") LDGraphicsWindow.BackgroundBrush(brr) gw = GraphicsWindow.Width gh = GraphicsWindow.Height xo = gw / 2 yo = gh / 2 zo = 0 element["H"] = "color=White;size=55;1=32;" element["C"] = "color=teal;size=85;1=75;2=67;3=60;" element["O"] = "color=#EE0000;size=76;1=63;2=57;3=53;h=272;" ec = "solid=White;dotted=#77aaaaaa GraphicsWindow.KeyDown = OnKeyUp EndSub Sub InitAtoms ' z1 atom[11] = "element=C;x=-1;y=-1;z=1;" atom[12] = "element=C;x=1;y=-1;z=1;" atom[13] = "element=C;x=-0.5;y=0;z=1;" atom[14] = "element=C;x=0.5;y=0;z=1;" atom[15] = "element=C;x=-1;y=1;z=1;" atom[16] = "element=C;x=1;y=1;z=1;" p = "element=O;y=-0.75;z=1;" p["x"] = -Math.SquareRoot(3) / 4 atom[17] = p p["x"] = Math.SquareRoot(3) / 4 atom[18] = p p = "element=O;x=0;y=-0.5;z=1;" atom[19] = p p["y"] = 0.5 atom[20] = p p = "element=O;y=0.75;z=1;" p["x"] = -Math.SquareRoot(3) / 4 atom[21] = p p["x"] = Math.SquareRoot(3) / 4 atom[22] = p ' z2 p = "element=O;x=-1;z=0.75;" p["y"] = -1 + 1 / Math.SquareRoot(3) atom[31] = p p["x"] = 1 atom[32] = p p["x"] = -1 p["y"] = 1 - 1 / Math.SquareRoot(3) atom[33] = p p["x"] = 1 atom[34] = p ' z3 p = "element=O;x=0;y=-0.25;" p["z"] = 1 / Math.SquareRoot(3) atom[41] = p p["y"] = 0.25 atom[42] = p p["x"] = -0.375 * Math.SquareRoot(3) p["y"] = -1 + 0.375 atom[43] = p p["x"] = 0.375 * Math.SquareRoot(3) atom[44] = p p["x"] = -0.375 * Math.SquareRoot(3) p["y"] = 1 - 0.375 atom[45] = p p["x"] = 0.375 * Math.SquareRoot(3) atom[46] = p ' z4 p = "element=C;x=0;y=-1;z=0.5;" atom[51] = p p["y"] = 1 atom[52] = p p = "element=O;x=-1;y=0;z=0.5;" atom[53] = p p["x"] = 1 atom[54] = p ' z5 p = "element=O;x=-0.75;y=-1;" p["z"] = Math.SquareRoot(3) / 4 atom[61] = p p["x"] = 0.75 atom[62] = p p["x"] = -0.75 p["y"] = 1 atom[63] = p p["x"] = 0.75 atom[64] = p p["x"] = -0.375 p["y"] = -1 + 0.375 * Math.SquareRoot(3) atom[65] = p p["x"] = 0.375 atom[66] = p p["x"] = -0.375 p["y"] = 1 - 0.375 * Math.SquareRoot(3) atom[67] = p p["x"] = 0.375 atom[68] = p ' z6 p = "element=O;y=0;z=0.25;" p["x"] = -1 / Math.SquareRoot(3) atom[71] = p p["x"] = 1 / Math.SquareRoot(3) atom[72] = p ' z7 atom[81] = "element=C;x=0;y=0;z=0;" p = "element=C;x=-1;y=-0.5;z=0; atom[82] = p p["x"] = 1 atom[83] = p p = "element=C;x=-1;y=0.5;z=0; atom[84] = p p["x"] = 1 atom[85] = p p = "element=O;x=-0.5;y=-1;z=0;" atom[86] = p p["x"] = 0.5 atom[87] = p p = "element=O;x=-0.5;y=1;z=0;" atom[88] = p p["x"] = 0.5 atom[89] = p p = "element=O;x=-0.25;z=0;" p["y"] = -1 / Math.SquareRoot(3) atom[90] = p p["x"] = 0.25 atom[91] = p p = "element=O;x=-0.25;z=0;" p["y"] = 1 / Math.SquareRoot(3) atom[92] = p p["x"] = 0.25 atom[93] = p ' z8 p = "element=O;y=0;z=-0.25" p["x"] = -1 / Math.SquareRoot(3) atom[101] = p p["x"] = 1 / Math.SquareRoot(3) atom[102] = p ' z9 p = "element=O;x=-0.75;y=-1;" p["z"] = -Math.SquareRoot(3) / 4 atom[111] = p p["x"] = 0.75 atom[112] = p p["x"] = -0.75 p["y"] = 1 atom[113] = p p["x"] = 0.75 atom[114] = p p["x"] = -0.375 p["y"] = -1 + 0.375 * Math.SquareRoot(3) atom[115] = p p["x"] = 0.375 atom[116] = p p["x"] = -0.375 p["y"] = 1 - 0.375 * Math.SquareRoot(3) atom[117] = p p["x"] = 0.375 atom[118] = p ' z10 p = "element=C;x=0;y=-1;z=-0.5;" atom[121] = p p["y"] = 1 atom[122] = p p = "element=O;x=-1;y=0;z=-0.5;" atom[123] = p p["x"] = 1 atom[124] = p ' z11 p = "element=O;x=0;y=-0.25;" p["z"] = -1 / Math.SquareRoot(3) atom[131] = p p["y"] = 0.25 atom[132] = p p["x"] = -0.375 * Math.SquareRoot(3) p["y"] = -1 + 0.375 atom[133] = p p["x"] = 0.375 * Math.SquareRoot(3) atom[134] = p p["x"] = -0.375 * Math.SquareRoot(3) p["y"] = 1 - 0.375 atom[135] = p p["x"] = 0.375 * Math.SquareRoot(3) atom[136] = p ' z12 p = "element=O;x=-1;z=-0.75;" p["y"] = -1 + 1 / Math.SquareRoot(3) atom[141] = p p["x"] = 1 atom[142] = p p["x"] = -1 p["y"] = 1 - 1 / Math.SquareRoot(3) atom[143] = p p["x"] = 1 atom[144] = p ' z13 atom[151] = "element=C;x=-1;y=-1;z=-1;" atom[152] = "element=C;x=1;y=-1;z=-1;" p = "element=C;x=-0.5;y=0;z=-1;" atom[153] = p p["x"] = 0.5 atom[154] = p atom[155] = "element=C;x=-1;y=1;z=-1;" atom[156] = "element=C;x=1;y=1;z=-1;" p = "element=O;y=-0.75;z=-1;" p["x"] = -Math.SquareRoot(3) / 4 atom[157] = p p["x"] = Math.SquareRoot(3) / 4 atom[158] = p p = "element=O;x=0;y=-0.5;z=-1;" atom[159] = p p["y"] = 0.5 atom[160] = p p = "element=O;y=0.75;z=-1;" p["x"] = -Math.SquareRoot(3) / 4 atom[161] = p p["x"] = Math.SquareRoot(3) / 4 atom[162] = p EndSub Sub InitEdges ' z1 p = atom[17] p["y"] = -1 vertex[217] = p p = atom[18] p["y"] = -1 vertex[218] = p p = atom[31] p["z"] = 1 vertex[231] = p p = atom[32] p["z"] = 1 vertex[232] = p p = atom[33] p["z"] = 1 vertex[233] = p p = atom[34] p["z"] = 1 vertex[234] = p p = atom[21] p["y"] = 1 vertex[221] = p p = atom[22] p["y"] = 1 vertex[222] = p ' z5 p = atom[61] p["x"] = -1 vertex[261] = p p = atom[62] p["x"] = 1 vertex[262] = p p = atom[63] p["x"] = -1 vertex[263] = p p = atom[64] p["x"] = 1 vertex[264] = p ' z9 p = atom[111] p["x"] = -1 vertex[311] = p p = atom[112] p["x"] = 1 vertex[312] = p p = atom[113] p["x"] = -1 vertex[313] = p p = atom[114] p["x"] = 1 vertex[314] = p ' z13 p = atom[157] p["y"] = -1 vertex[357] = p p = atom[158] p["y"] = -1 vertex[358] = p p = atom[141] p["z"] = -1 vertex[341] = p p = atom[142] p["z"] = -1 vertex[342] = p p = atom[143] p["z"] = -1 vertex[343] = p p = atom[144] p["z"] = -1 vertex[344] = p p = atom[161] p["y"] = 1 vertex[361] = p p = atom[162] p["y"] = 1 vertex[362] = p ' z1 edge = "1=dotted,11-12-16-15-11;2=solid,217-17-19-18-218;" edge = edge + "3=dotted,17-231;4=dotted,18-232;" edge = edge + "5=dotted,21-233;6=dotted,22-234;" edge = edge + "7=solid,221-21-20-22-222;" edge = edge + "8=dotted,19-20;" ' z1 - z2 edge = edge + "9=solid,231-31;10=solid,232-32;" edge = edge + "11=solid,233-33;12=solid,234-34;" ' z1 - z3 edge = edge + "13=solid,17-43;14=solid,18-44;15=solid,19-41;" edge = edge + "16=solid,21-45;17=solid,22-46;18=solid,20-42;" ' z3 edge = edge + "19=solid,41-42;" ' z2 - z3 edge = edge + "20=solid,31-43;21=solid,32-44;" edge = edge + "22=solid,33-45;23=solid,34-46;" ' z2 - z4 edge = edge + "24=solid,31-53;25=solid,32-54;" edge = edge + "26=solid,33-53;27=solid,34-54;" ' z1 - z5 edge = edge + "28=dotted,217-61;29=dotted,218-62;" edge = edge + "30=dotted,221-63;31=dotted,222-64;" ' z2 - z5 edge = edge + "32=dotted,31-261;33=dotted,32-262;" edge = edge + "34=dotted,33-263;35=dotted,34-264;" ' z3 - z5 edge = edge + "36=solid,41-65;37=solid,41-66;" edge = edge + "38=solid,42-67;39=solid,42-68;" edge = edge + "40=solid,43-61;41=solid,43-65;" edge = edge + "42=solid,44-62;43=solid,44-66;" edge = edge + "44=solid,45-63;45=solid,45-67;" edge = edge + "46=solid,46-64;47=solid,46-68;" ' z5 edge = edge + "48=solid,261-61;49=solid,262-62;" edge = edge + "50=solid,263-63;51=solid,264-64;" ' z4 - z6 edge = edge + "52=solid,53-71;53=solid,54-72;" ' z5 - z6 edge = edge + "54=solid,65-71;55=solid,67-71;" edge = edge + "56=solid,66-72;57=solid,68-72;" ' z5 - z7 edge = edge + "58=solid,61-86;59=solid,62-87;" edge = edge + "60=solid,63-88;61=solid,64-89;" edge = edge + "62=solid,65-90;63=solid,66-91;" edge = edge + "64=solid,67-92;65=solid,68-93;" ' z7 edge = edge + "66=solid,86-90-91-87;67=solid,88-92-93-89;" edge = edge + "68=dotted,86-87;69=dotted,88-89;" ' z6 - z8 edge = edge + "70=solid,71-101;71=solid,72-102;" ' z7 - z9 edge = edge + "72=solid,86-111;73=solid,87-112;" edge = edge + "74=solid,88-113;75=solid,89-114;" edge = edge + "76=solid,90-115;77=solid,91-116;" edge = edge + "78=solid,92-117;79=solid,93-118;" ' z8 - z9 edge = edge + "80=solid,101-115;81=solid,101-117;" edge = edge + "82=solid,102-116;83=solid,102-118;" ' z9 edge = edge + "84=solid,311-111;85=solid,312-112;" edge = edge + "86=solid,313-113;87=solid,314-114;" ' z4 - z10 edge = edge + "88=dotted,53-123;89=dotted,54-124;" ' z8 - z10 edge = edge + "90=solid,101-123;91=solid,102-124;" ' z9 - z11 edge = edge + "92=solid,115-133;93=solid,115-131;" edge = edge + "94=solid,116-134;95=solid,116-131;" edge = edge + "96=solid,117-135;97=solid,117-132;" edge = edge + "98=solid,118-136;99=solid,118-132;" edge = edge + "100=solid,111-133;101=solid,112-134;" edge = edge + "102=solid,113-135;103=solid,114-136;" ' z11 edge = edge + "104=solid,131-132;" ' z9 - z12 edge = edge + "105=dotted,311-141;106=dotted,312-142;" edge = edge + "107=dotted,313-143;108=dotted,314-144;" ' z10 - z12 edge = edge + "109=solid,123-141;110=solid,123-143;" edge = edge + "111=solid,124-142;112=solid,124-144;" ' z11 - z12 edge = edge + "113=solid,133-141;114=solid,134-142;" edge = edge + "115=solid,135-143;116=solid,136-144;" ' z1 - z13 edge = edge + "117=dotted,11-151;118=dotted,12-152;" edge = edge + "119=dotted,15-155;120=dotted,16-156;" ' z9 - z13 edge = edge + "121=dotted,111-357;122=dotted,112-358;" edge = edge + "123=dotted,113-361;124=dotted,114-362;" ' z11 - z13 edge = edge + "125=solid,133-157;126=solid,134-158;" edge = edge + "127=solid,135-161;128=solid,136-162;" edge = edge + "129=solid,131-159;130=solid,132-160;" ' z12 - z13 edge = edge + "131=solid,141-341;132=solid,142-342;" edge = edge + "133=solid,143-343;134=solid,144-344;" ' z13 edge = edge + "135=dotted,151-152-156-155-151;" edge = edge + "136=solid,357-157-159-158-358;" edge = edge + "137=dotted,157-341;138=dotted,158-342;" edge = edge + "139=dotted,161-343;140=dotted,162-344;" edge = edge + "141=solid,361-161-160-162-362;" edge = edge + "142=dotted,159-160;" EndSub Sub InitVectors nVector = 0 indexV = "" index = Array.GetAllIndices(atom) nAtom = Array.GetItemCount(atom) For iAtom = 1 To nAtom i = index[iAtom] p = atom[i] v[1][1] = p["x"] v[2][1] = p["y"] v[3][1] = p["z"] param = "rows=3;cols=1;" param["name"] = "v" + i param["init"] = v Matrix_Init() nVector = nVector + 1 indexV[nVector] = index[iAtom] EndFor If option["edge"] Then index = Array.GetAllIndices(vertex) nVertex = Array.GetItemCount(vertex) For iVertex = 1 To nVertex i = index[iVertex] p = vertex[i] v[1][1] = p["x"] v[2][1] = p["y"] v[3][1] = p["z"] param = "rows=3;cols=1;" param["name"] = "v" + i param["init"] = v Matrix_Init() nVector = nVector + 1 indexV[nVector] = index[iVertex] EndFor EndIf EndSub Sub Map x = xo + scale * p["x"] y = yo + scale * p["y"] z = zo + scale * p["z"] EndSub Sub OnKeyUp keyUp = "True" EndSub Sub RotateAtoms aa = 0 ' angle around x-axis [radians] bb = 0 ' angle around y-axis [radians] zz = 0 ' angle around z-axis [radians] If key = "Up" Then aa = -Math.GetRadians(3) ElseIf key = "Down" Then aa = Math.GetRadians(3) ElseIf key = "Left" Then bb = Math.GetRadians(3) Else ' key = "Right" bb = -Math.GetRadians(3) EndIf da=da+aa db=db+bb ' GraphicsWindow.Title=LDMath.FixDecimal( Math.GetDegrees(da) 2)+" : "+LDMath.FixDecimal(Math.GetDegrees(db) 2) m[1][1] = Math.Cos(bb) * Math.Cos(zz) m[1][2] = Math.Sin(aa) * Math.Sin(bb) * Math.Cos(zz) - Math.Cos(aa) * Math.Sin(zz) m[1][3] = Math.Sin(aa) * Math.Sin(zz) + Math.Cos(aa) * Math.Sin(bb) * Math.Cos(zz) m[2][1] = Math.Cos(bb) * Math.Sin(zz) m[2][2] = Math.Sin(aa) * Math.Sin(bb) * Math.Sin(zz) + Math.Cos(aa) * Math.Cos(zz) m[2][3] = -Math.Sin(aa) * Math.Cos(zz) + Math.Cos(aa) * Math.Sin(bb) * Math.Sin(zz) m[3][1] = -Math.Sin(bb) m[3][2] = Math.Sin(aa) * Math.Cos(bb) m[3][3] = Math.Cos(aa) * Math.Cos(bb) param = "name=R;rows=3;cols=3;" param["init"] = m Matrix_Init() For iVector = 1 To nVector param = "name1=R;" param["name2"] = "v" + indexV[iVector] param["name"] = "v" + indexV[iVector] Matrix_Mul() EndFor EndSub Sub Color_Blacken Color_NameToColor() Color_ColorToRGB() r = Math.Floor(r * (1 - rate)) g = Math.Floor(g * (1 - rate)) b = Math.Floor(b * (1 - rate)) c = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_ColorToRGB If Text.GetLength(c) = 9 Then _alpha = 2 Else _alpha = 0 EndIf r = ldmath.Base2Decimal( Text.GetSubText(c, _alpha + 2, 2) 16) g = ldmath.Base2Decimal( Text.GetSubText(c, _alpha + 4, 2) 16) b = ldmath.Base2Decimal( Text.GetSubText(c, _alpha + 6, 2) 16) EndSub Sub Color_NameToColor If Text.StartsWith(c, "#") And 6 < Text.GetLength(c) Then c = Text.ConvertToUpperCase(c) Else Stack.PushValue("local", GraphicsWindow.PenColor) GraphicsWindow.PenColor = c c = GraphicsWindow.PenColor GraphicsWindow.PenColor = Stack.PopValue("local") EndIf EndSub Sub Matrix_Init name = param["name"] rows = param["rows"] cols = param["cols"] init = param["init"] _init = "" _rows = Array.GetItemCount(init) _row = Array.GetAllIndices(init) For j = 1 To _rows row = _row[j] _cols = Array.GetItemCount(init[row]) _col = Array.GetAllIndices(init[row]) For i = 1 To _cols col = _col[i] _init[row][col] = init[row][col] EndFor EndFor entry["rows"] = rows entry["cols"] = cols entry["values"] = _init matrix[name] = entry EndSub Sub Matrix_Mul name1 = param["name1"] entry1 = matrix[name1] cols1 = entry1["cols"] rows1 = entry1["rows"] name2 = param["name2"] entry2 = matrix[name2] cols2 = entry2["cols"] rows2 = entry2["rows"] If cols1 = rows2 Then values1 = entry1["values"] values2 = entry2["values"] values = "" For col = 1 To cols2 For row = 1 To rows1 For i = 1 To cols1 values[row][col] = values[row][col] + values1[row][i] * values2[i][col] EndFor EndFor EndFor name = param["name"] Stack.PushValue("local", param) param = "" param["name"] = name param["cols"] = cols2 param["rows"] = rows1 param["init"] = values Matrix_Init() param = Stack.PopValue("local") EndIf EndSub Sub Vector_Comp name1 = param["name1"] name2 = param["name2"] entry1 = matrix[name1] entry2 = matrix[name2] cols1 = entry1["cols"] cols2 = entry2["cols"] rows1 = entry1["rows"] rows2 = entry2["rows"] values1 = entry1["values"] values2 = entry2["values"] z1 = values1[3][1] z2 = values2[3][1] lt = "False" le = "False" eq = "False" gt = "False" ge = "False" If z1 < z2 Then lt = "True" le = "True" ElseIf z1 = z2 Then y1 = values1[2][1] y2 = values2[2][1] If y1 < y2 Then gt = "True" ge = "True" ElseIf y1 = y2 Then x1 = values1[1][1] x2 = values2[1][1] If x1 < x2 Then gt = "True" ge = "True" ElseIf x1 = x2 Then le = "True" eq = "True" ge = "True" Else ' x1 > x2 le = "True" lt = "True" EndIf Else ' y1 > y2 le = "True" lt = "True" EndIf Else ' z1 > z2 gt = "True" ge = "True" EndIf EndSub End>QQN144.sb< Start>QQP196-1.sb< 'program by Yvan Leduc, April 6th 2016 ' program no: image1=ImageList.LoadImage("https://discoverynewfrontiers.nasa.gov/missions/images/Juno/junos_c.jpg") graphicsWindow.Clear() ' cls GraphicsWindow.Title = "Juno" GraphicsWindow.top= 0 GraphicsWindow.left= 0 GraphicsWindow.Height = 700 GraphicsWindow.Width = 840 GraphicsWindow.DrawresizedImage(image1,0,0,840, 700) buttonclicked = 0 GraphicsWindow.FontSize = 35 GraphicsWindow.BrushColor = "gray" GraphicsWindow.FontSize = 35 GraphicsWindow.BrushColor = "gray" GraphicsWindow.DrawBoundText(50, 20, 500, "Days left ") GraphicsWindow.FontSize = 75 GraphicsWindow.BrushColor = "lightgray" date = Shapes.AddText("") Shapes.Move(date,250, 20) Timer.Interval = 100 Timer.Tick = OnTick Sub OnTick days_left=LDDateTime.Subtract("2016/07/04 22:13:00",LDDateTime.Now()) days = math.Floor(days_left) hours_left = (days_left-days)*24 hours = math.Floor(hours_left) mins_left = (hours_left-hours)*60 mins = math.Floor(mins_left) secs_left = (mins_left-mins)*60 secs = math.Floor(secs_left) Shapes.SetText(date,days+":"+hours+":"+mins+":"+secs) EndSub End>QQP196-1.sb< Start>QQP196.sb< 'program by Yvan Leduc, April 6th 2016 ' program no: image1=ImageList.LoadImage("https://discoverynewfrontiers.nasa.gov/missions/images/Juno/junos_c.jpg") graphicsWindow.Clear() ' cls GraphicsWindow.Title = "Juno" GraphicsWindow.top= 0 GraphicsWindow.left= 0 GraphicsWindow.Height = 700 GraphicsWindow.Width = 840 GraphicsWindow.DrawresizedImage(image1,0,0,840, 700) buttonclicked = 0 GraphicsWindow.FontSize = 35 GraphicsWindow.BrushColor = "gray" date1=LDDateTime.Now() date2="2016/07/04 22:13:00" days_left=LDDateTime.Subtract(date1,date2) days_left=math.Round(days_left*10)/10 days_left=math.Abs(days_left) GraphicsWindow.FontSize = 35 GraphicsWindow.BrushColor = "gray" GraphicsWindow.DrawBoundText(50, 20, 500, "Days left: ") GraphicsWindow.FontSize = 75 GraphicsWindow.BrushColor = "lightgray" GraphicsWindow.DrawBoundText(250, 20, 500, days_left) End>QQP196.sb< Start>QQQ053.sb< 'Constans F = "False" T = "True" gt = 1 gl = 1 gw = Desktop.Width - 20 gh = Desktop.Height - 70 bac = LDColours.White brc = LDColours.SteelBlue fo[1] = "Consolas" fo[2] = 12 fo[3] = F 'Fett fo[4] = F 'Kursiv GraphicsWindow.Top = gt GraphicsWindow.Left = gl GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = bac GraphicsWindow.BrushColor = brc GraphicsWindow.FontName = fo[1] GraphicsWindow.FontSize = fo[2] GraphicsWindow.FontBold = fo[3] GraphicsWindow.FontItalic = fo[4] GraphicsWindow.Title="Database" GraphicsWindow.Show() dt = Clock.Date dt = LDDialogs.Calendar(dt) GraphicsWindow.Hide() GraphicsWindow.Show() col = LDDialogs.Colour() fo = LDDialogs.Font(fo) GraphicsWindow.FontName = fo[1] GraphicsWindow.FontSize = fo[2] GraphicsWindow.FontBold = fo[3] GraphicsWindow.FontItalic = fo[4] path = Program.Directory path = LDDialogs.GetFolder(path) openfile = LDDialogs.OpenFile("*", path) savefile = LDDialogs.SaveFile("*", path) End>QQQ053.sb< Start>QQR266.sb< ' TicTacToe // original BJX729 made by gucerni // shortened version by NaochanON menu() Sub menu GraphicsWindow.CanResize = "no" GraphicsWindow.Width = 370 GraphicsWindow.Height = 300 GraphicsWindow.PenWidth = 5 GraphicsWindow.PenColor = "gainsboro" GraphicsWindow.DrawEllipse(180,0,100,100)'circulo superior GraphicsWindow.DrawLine(0,80,100,50)'X izquierda GraphicsWindow.DrawLine(10,0,10,170) GraphicsWindow.DrawLine(260,150,260,300)'X derecha GraphicsWindow.DrawLine(180,280,370,220) dat="1=SMALL,00033,00130,00050;2=TIC ,00032,00160,00090;3=TAC ,00024,00165,00130;4=TOE ,00018,00170,00160" GraphicsWindow.BrushColor = "black" For i=1 To Array.GetItemCount(dat) GraphicsWindow.FontSize =text.GetSubText(dat[i],10,2) GraphicsWindow.DrawText(text.GetSubText(dat[i],13,5)*1,text.GetSubText(dat[i],19,5)*1,text.GetSubText(dat[i],1,5)) EndFor GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "black" lns="1=1\=0\;2\=190\;3\=150\;4\=0\;;2=1\=130\;2\=300\;3\=350\;4\=0\;;3=1\=30\;2\=0\;3\=370\;4\=190\;;4=1\=0\;2\=190\;3\=170\;4\=300\;;" For i=1 To Array.GetItemCount(lns) v=Shapes.AddLine(lns[i][1],lns[i][2],lns[i][3],lns[i][4]) Shapes.SetOpacity(v,10) EndFor btnPlay1 = Controls.AddButton("1 Jugador",70,210) btnPlay2 = Controls.AddButton("2 Jugadores",200,210) Controls.ButtonClicked = Botones EndSub Sub Botones ultimoBtn = Controls.LastClickedButton If ultimoBtn = btnPlay1 Then GraphicsWindow.MouseDown = clicX2 ' single player inter() inicio() jugadas() EndIf If ultimoBtn = btnPlay2 Then GraphicsWindow.MouseDown = clicX ' double player inicio() EndIf EndSub Sub inicio GraphicsWindow.Clear() interruptor = 1 GraphicsWindow.Width = 370 GraphicsWindow.Height = 300 GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = "Green" GraphicsWindow.CanResize = "no" GraphicsWindow.DrawLine(80,110,290,110) GraphicsWindow.DrawLine(80,170,290,170) GraphicsWindow.DrawLine(150,60,150,220) GraphicsWindow.DrawLine(220,60,220,220) matriz="1=1\=0\;2\=0\;3\=0\;;2=1\=0\;2\=0\;3\=0\;;3=1\=0\;2\=0\;3\=0\;;" EndSub Sub clicX ' double player If Math.Remainder(interruptor,2) = 0 Then figuraO() EndIf If Math.Remainder(interruptor,2) <> 0 Then figuraX() EndIf EndSub Sub clicX2 ' single player If Math.Remainder(interruptor,2) = 0 Then figuraX() EndIf If Math.Remainder(interruptor,2) <> 0 Then jugadas() EndIf EndSub Sub inter interruptor = interruptor + 1 If interruptor = 10 Then Reinicio() EndIf EndSub Sub FiguraX GraphicsWindow.PenColor = "Blue" gmX = GraphicsWindow.MouseX gmY = GraphicsWindow.MouseY dx=70 dy=55 For j=1 To 3 For i=1 To 3 If gmX >= 85+dx*(i-1) And gmX <= 145+dx*(i-1) And gmY >= 65+dy*(j-1) And gmY <= 105+dy*(j-1) Then If matriz[j][i] = 0 Then GraphicsWindow.DrawLine(100+dx*(i-1),70+dy*(j-1),130+dx*(i-1),100+dy*(j-1)) GraphicsWindow.DrawLine(100+dx*(i-1),100+dy*(j-1),130+dx*(i-1),70+dy*(j-1)) matriz[j][i] = 1 inter() SumaMatriz() i=3 j=3 EndIf EndIf EndFor EndFor EndSub Sub FiguraO GraphicsWindow.PenColor = "Red" gwX = GraphicsWindow.MouseX gwY = GraphicsWindow.MouseY For j=1 To 3 For i=1 To 3 If gwX >= 85+dx*(i-1) And gwX <= 145+dx*(i-1) And gwY >= 65+dy*(j-1) And gwY <= 105+dy*(j-1) Then If matriz[j][i] = 0 Then GraphicsWindow.DrawEllipse(100+dx*(i-1),70+dy*(j-1),30,30) matriz[j][i] = 9 inter() SumaMatriz() i=3 j=3 EndIf EndIf EndFor EndFor EndSub Sub SumaMatriz GraphicsWindow.PenWidth = 5 SLine="" If matriz[1][1] + matriz[1][2] + matriz[1][3] = 3 Or matriz[1][1] + matriz[1][2] + matriz[1][3] = 27 Then SLine="1=50;2=85;3=320;4=85" elseIf matriz[2][1] + matriz[2][2] + matriz[2][3] = 3 Or matriz[2][1] + matriz[2][2] + matriz[2][3] = 27 Then SLine="1=50;2=140;3=320;4=140" elseIf matriz[3][1] + matriz[3][2] + matriz[3][3] = 3 Or matriz[3][1] + matriz[3][2] + matriz[3][3] = 27 Then SLine="1=50;2=195;3=320;4=195" elseIf matriz[1][1] + matriz[2][1] + matriz[3][1] = 3 Or matriz[1][1] + matriz[2][1] + matriz[3][1] = 27 Then SLine="1=115;2=30;3=115;4=250" elseIf matriz[1][2] + matriz[2][2] + matriz[3][2] = 3 Or matriz[1][2] + matriz[2][2] + matriz[3][2] = 27 Then SLine="1=185;2=30;3=185;4=250" elseIf matriz[1][3] + matriz[2][3] + matriz[3][3] = 3 Or matriz[1][3] + matriz[2][3] + matriz[3][3] = 27 Then SLine="1=255;2=30;3=255;4=250" elseIf matriz[1][1] + matriz[2][2] + matriz[3][3] = 3 Or matriz[1][1] + matriz[2][2] + matriz[3][3] = 27 Then SLine="1=90;2=60;3=280;4=220" elseIf matriz[3][1] + matriz[2][2] + matriz[1][3] = 3 Or matriz[3][1] + matriz[2][2] + matriz[1][3] = 27 Then SLine="1=90;2=220;3=280;4=60" EndIf If Sline<>"" Then GraphicsWindow.DrawLine(SLine[1],SLine[2],SLine[3],SLine[4]) interruptor = 0 matriz="1=1\=0\;2\=0\;3\=0\;;2=1\=0\;2\=0\;3\=0\;;3=1\=0\;2\=0\;3\=0\;;" Reinicio() Sound.PlayBellRing() EndIf GraphicsWindow.PenWidth = 2 EndSub Sub Reinicio GraphicsWindow.FontSize = 12 reiniciar = Controls.AddButton("Reiniciar Partida",70,260) menuPrincipal = Controls.AddButton("Menu Principal",200,260) Controls.ButtonClicked = BtnReinicio EndSub Sub BtnReinicio ultimoBtnReinicio = Controls.LastClickedButton If ultimoBtnReinicio = reiniciar Then GraphicsWindow.Clear() inter() inicio() jugadas() EndIf If ultimoBtnReinicio = menuPrincipal Then GraphicsWindow.Clear() menu() EndIf EndSub Sub jugadas If math.Remainder(interruptor,2) = 1 Then comprobar = 0 While comprobar = 0 casilla = Math.GetRandomNumber(9) X=math.Remainder(casilla-1,3)+1 Y=Math.Floor(casilla/3)+1 If matriz[Y][X] = 0 Then GraphicsWindow.PenColor = "Red" GraphicsWindow.DrawEllipse(100+dx*(X-1),70+dy*(Y-1),30,30)'ubicacion 1,1 matriz[Y][X] = 9 inter() SumaMatriz() comprobar = 1 EndIf EndWhile EndIf EndSub End>QQR266.sb< Start>QQS326-0.sb< Turtle.Angle =90 Turtle.Speed=10 GraphicsWindow.Width=650 GraphicsWindow .Height=650 Turtle.x=325 Turtle.y=200 aa=90 GraphicsWindow.Title ="Sunspinning GraphicsWindow.PenColor ="yellow GraphicsWindow.BackgroundColor ="skyblue i=1 For x=1 To 40 Turtle.Move (1) d=math.Remainder (x 2) Turtle.Angle = Turtle.Angle-90+15 Turtle.Move (50+d*30) aaa[i][1]=Turtle.X aaa[i][2]=Turtle.Y i=i+1 Turtle.Angle = Turtle.Angle+165 Turtle.Move (50+d*30) aaa[i][1]=Turtle.X aaa[i][2]=Turtle.Y i=i+1 aa=aa+9 Turtle.Angle=aa EndFor Turtle.Hide () LDShapes.RemoveTurtleLines () GraphicsWindow.PenColor ="transparent GraphicsWindow.PenWidth=0 Program.Delay(200) ss=LDShapes.AddPolygon (aaa) oo=LDShapes.AddPolygon (aaa) LDShapes.Centre (oo 325 325) LDShapes.Centre (ss 330 335) LDShapes.BrushColour (oo "yellow") LDShapes.BrushColour (ss "#33000000") aa=0 While 1=1 LDShapes.RotateAbout (oo 325 325 aa) LDShapes.RotateAbout (ss 330 335 aa) Program.Delay (20) aa=aa+.5 EndWhile End>QQS326-0.sb< Start>QQS326.sb< Turtle.Angle =90 Turtle.Speed=9 GraphicsWindow.Width=650 GraphicsWindow .Height=650 Turtle.x=325 Turtle.y=200 aa=90 GraphicsWindow.Title ="Sunspinning GraphicsWindow.PenColor ="yellow GraphicsWindow.BackgroundColor ="teal i=1 For x=1 To 40 Turtle.Move (1) d=math.Remainder (x 2) Turtle.Angle = Turtle.Angle-90+15 Turtle.Move (50+d*30) aaa[i][1]=Turtle.X aaa[i][2]=Turtle.Y i=i+1 Turtle.Angle = Turtle.Angle+165 Turtle.Move (50+d*30) aaa[i][1]=Turtle.X aaa[i][2]=Turtle.Y i=i+1 aa=aa+9 Turtle.Angle=aa EndFor Turtle.Hide () LDShapes.RemoveTurtleLines () GraphicsWindow.PenWidth=0 oo=LDShapes.AddPolygon (aaa) LDEffect.DropShaddow (oo "") LDShapes.Centre (oo 325 325) 'ldShapes.AnimateRotation (oo 4500 0) LDShapes.BrushColour (oo "yellow") aa=0 While 1=1 LDShapes.RotateAbout (oo 325 325 aa) Program.Delay (20) aa=aa+.5 EndWhile End>QQS326.sb< Start>QQX638.sb< ls="d r 4.5 -.25 l 1.25 -.25 l 4.25 -.25 r 1.25 -.25 r 4.25 -.25 u r 2.25 l .8 l lz="u r 4.5 l l d 4.5 -.25 r 1.25 -.25 r 4.25 -.25 l 1.25 -.25 l 4.25 -.25 u l 2.25 l 4.8 l li="d 2.5 u .5 d .5 u -3.5 r .8 l ln="d 2.45 u -.25 d r 4.25 -.25 r 2.25 u l .8 l lx="d 1.5 u -.25 d r .8 l 1.25 -1.25 r 3 l 1.25 -1.25 r 1.25 -.25 r 1.25 u l .8 l lc="u .25 d r -.25 4.25 u -4 d l d 2.25 u -.25 d r 4 u r 2.5 l .6 l ll="u .25 d 3.5 u -3.75 r .8 l lr="d 2.45 u -.25 d r 4 l la="u 2.5 r d -.25 4.5 -.25 r 2.25 -.25 r 4.25 -.25 r 1.25 -.25 r 4 r u 1.25 l .8 l lp="d -1.5 1.5 2.45 u -.25 d r 1.5 -.25 r 2.25 -.25 r 1 -1 u r r .8 r .25 l l lu="u 2.7 r r d 2.45 u -.25 d l 2.25 -.25 l 2.25 u -2.45 r .8 l lM="d 2.45 u -.25 d r 2 r 2.25 -2.25 l 2.25 -.25 r 2.25 u l .8 l ltr="u .25 d 3.5 u -3.75 r 1 l u .25 d 2.45 u -.25 d r 2 r u 2.45 l .4 l le="u r 4 d l .25 l d -.25 4.5 -.25 r 2.25 -.25 r 4.25 -.25 r 1.25 -.25 r 4 l u 1.25 l 4.8 l lct="u .25 d r -.25 4.25 u -4 d l d 2.25 u -.25 d r 4 u .25 d 1 u -1.25 r 2.5 l .6 l GraphicsWindow.Title="ZX font Turtle.Speed=10 GraphicsWindow.BackgroundColor="#333333 args=0 Turtle.x=45 Turtle.y=80 LDCall.Function3("drw" ls 10 "red") LDCall.Function3("drw" li 10 "red") LDCall.Function3("drw" ln 10 "red") LDCall.Function3("drw" lc 10 "red") LDCall.Function3("drw" ll 10 "red") LDCall.Function3("drw" la 10 "red") LDCall.Function3("drw" li 10 "red") LDCall.Function3("drw" lr 10 "red") Turtle.x=45 Turtle.y=150 LDCall.Function3("drw" lz 10 "red") LDCall.Function3("drw" lx 10 "red") Turtle.x=45 Turtle.y=150 LDCall.Function3("drw" lz 7 "black") LDCall.Function3("drw" lx 7 "black") Turtle.x=45 Turtle.y=220 LDCall.Function3("drw" ls 10 "red") LDCall.Function3("drw" lp 10 "red") LDCall.Function3("drw" le 10 "red") LDCall.Function3("drw" lct 10 "red") LDCall.Function3("drw" ltr 10 "red") LDCall.Function3("drw" lu 10 "red") LDCall.Function3("drw" lm 10 "red") Turtle.Hide() Sub drw GraphicsWindow.PenWidth=args[2] GraphicsWindow.PenColor=args[3] aa= LDText.Split(args[1] " ") For x=1 To Array.GetItemCount(aa) if aa[x]="d" Then Turtle.PenDown() elseif aa[x]="u" Then Turtle.PenUp() elseif aa[x]="r" Then Turtle.TurnRight() elseif aa[x]="l" Then Turtle.TurnLeft() else Turtle.Move(aa[x]*20) EndIf EndFor EndSub End>QQX638.sb< Start>QRB861-0.sb< ' Drawn Using Ellipses only ' mahreen miangul Yandee Man ApRil 2017 ' Rectangles Triangles and The Line all are for Fun GraphicsWindow.Width = 1222 GraphicsWindow.Height = 555 GraphicsWindow.BackgroundColor = "darkslategray" GraphicsWindow.FontSize = 55 GraphicsWindow.DrawText(20,20,"Hello from mahreen miangul") MakeYandeeMan() ddx=-5 ddy=0 z=1 ''WhT dz=-0.02 ''WhT While "True" For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+ddx,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+ddx,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+ddx,shapes.GetTop(Tri[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+ddx,shapes.GetTop(line[i])+ddy) EndFor If Shapes.GetLeft(ell[1])<-200 Then moveright() EndIf Program.Delay(20) z=z+dz ''WhT If z=0 Or z=1 Then ''WhT dz=-dz ''WhT endif ''WhT Shapes.Zoom(ell[10],z,1) ''WhT Shapes.Zoom(ell[11],1,z) ''WhT endwhile Sub moveright el1y=shapes.GetTop(ell[1]) ddy= Math.GetRandomNumber(Math.Abs(300-el1y))-el1y For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+1200,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+1200,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+1200,shapes.GetTop(Tri[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+1200,shapes.GetTop(line[i])+ddy) 'haroon rashid changed 1200 to ddx EndFor ddy=0 EndSub ' Sprit Data Sub MakeYandeeMan ' elipses GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor="darkslategray" ell[1] = Shapes.Addellipse(500,500) Shapes.Move(ell[1], 98,44) ell[2] = Shapes.Addellipse(300,300) Shapes.Move(ell[2], 51,247) GraphicsWindow.BrushColor="springgreen" ell[3] = Shapes.Addellipse(20,50) '<-- leftEar Shapes.Move(ell[3], 162,120) ell[4] = Shapes.addellipse(20,50) '<-- rightEar Shapes.Move(ell[4], 318,120) GraphicsWindow.BrushColor="green" ell[5] = Shapes.Addellipse(150,200) '<---face Shapes.Move(ell[5], 175,50) GraphicsWindow.BrushColor="darkslategray" ell[6] = Shapes.Addellipse(350,110) '<---headTopCover Shapes.Move(ell[6], 75,50) GraphicsWindow.BrushColor="green" ell[7] = Shapes.Addellipse(150,60) '<---headTop Shapes.Move(ell[7], 175,129) GraphicsWindow.BrushColor="darkmagenta" ell[8] = Shapes.Addellipse(40,30) '<-------leftEye Shapes.Move(ell[8], 190,145) ell[9] = Shapes.Addellipse(40,30) '<-----rightEye Shapes.Move(ell[9], 270,145) GraphicsWindow.BrushColor="yellow" ell[10] = Shapes.Addellipse(35,30) '<----leftPupil Shapes.Move(ell[10], 193,145) ell[11] = Shapes.Addellipse(35,30) '<------rightPupil Shapes.Move(ell[11], 272,145) ' 1 triangles GraphicsWindow.BrushColor="gold" tri[1] = Shapes.Addtriangle(566,100,611,130,566,160) Shapes.Move(tri[1], -100,160) chrome=GraphicsWindow.getcolorfromrgb(215,219,213) GraphicsWindow.brushcolor=chrome tri[3] = Shapes.Addtriangle(585,405,585,420,450,390) Shapes.Move(tri[3], 0,0) GraphicsWindow.BrushColor="#000000" tri[4] = Shapes.Addtriangle(350,445,230,445,350,385) Shapes.Move(tri[4], 0,0) ' piston cylinder GraphicsWindow.brushcolor=chrome rec[12] = Shapes.Addrectangle(150,20) Shapes.Move(rec[12], 585,405) rec[13] = Shapes.Addrectangle(90,30) Shapes.Move(rec[13], 360,380) ' 1 lines GraphicsWindow.pencolor=chrome GraphicsWindow.penwidth= 2 line[1] = Shapes.Addline(615,120,500,120) Shapes.Move(line[1], -150,170) EndSub End>QRB861-0.sb< Start>QRB861.sb< ' Drawn Using Ellipses only ' mahreen miangul Yandee Man ApRil 2017 ' Rectangles Triangles and The Line all are for Fun GraphicsWindow.Width = 1222 GraphicsWindow.Height = 555 GraphicsWindow.BackgroundColor = "darkslategray" GraphicsWindow.FontSize = 55 GraphicsWindow.DrawText(20,20,"Hello from mahreen miangul") MakeYandeeMan() ddx=-5 ddy=0 While "True" For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+ddx,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+ddx,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+ddx,shapes.GetTop(Tri[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+ddx,shapes.GetTop(line[i])+ddy) EndFor If Shapes.GetLeft(ell[1])<-200 Then moveright() EndIf Program.Delay(20) endwhile Sub moveright el1y=shapes.GetTop(ell[1]) ddy= Math.GetRandomNumber(Math.Abs(300-el1y))-el1y For i=1 To 13 Shapes.Move(ell[i],Shapes.GetLeft(ell[i])+1200,shapes.GetTop(ell[i])+ddy) Shapes.Move(rec[i],Shapes.GetLeft(rec[i])+1200,shapes.GetTop(rec[i])+ddy) Shapes.Move(Tri[i],Shapes.GetLeft(Tri[i])+1200,shapes.GetTop(Tri[i])+ddy) Shapes.Move(line[i],Shapes.GetLeft(line[i])+1200,shapes.GetTop(line[i])+ddy) 'haroon rashid changed 1200 to ddx EndFor ddy=0 EndSub ' Sprit Data Sub MakeYandeeMan ' elipses GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor="darkslategray" ell[1] = Shapes.Addellipse(500,500) Shapes.Move(ell[1], 98,44) ell[2] = Shapes.Addellipse(300,300) Shapes.Move(ell[2], 51,247) GraphicsWindow.BrushColor="springgreen" ell[3] = Shapes.Addellipse(20,50) '<-- leftEar Shapes.Move(ell[3], 162,120) ell[4] = Shapes.addellipse(20,50) '<-- rightEar Shapes.Move(ell[4], 318,120) GraphicsWindow.BrushColor="green" ell[5] = Shapes.Addellipse(150,200) '<---face Shapes.Move(ell[5], 175,50) GraphicsWindow.BrushColor="darkslategray" ell[6] = Shapes.Addellipse(350,110) '<---headTopCover Shapes.Move(ell[6], 75,50) GraphicsWindow.BrushColor="green" ell[7] = Shapes.Addellipse(150,60) '<---headTop Shapes.Move(ell[7], 175,129) GraphicsWindow.BrushColor="darkmagenta" ell[8] = Shapes.Addellipse(40,30) '<-------leftEye Shapes.Move(ell[8], 190,145) ell[9] = Shapes.Addellipse(40,30) '<-----rightEye Shapes.Move(ell[9], 270,145) GraphicsWindow.BrushColor="yellow" ell[10] = Shapes.Addellipse(35,30) '<----leftPupil Shapes.Move(ell[10], 193,145) ell[11] = Shapes.Addellipse(35,30) '<------rightPupil Shapes.Move(ell[11], 272,145) ' 1 triangles GraphicsWindow.BrushColor="gold" tri[1] = Shapes.Addtriangle(566,100,611,130,566,160) Shapes.Move(tri[1], -100,160) chrome=GraphicsWindow.getcolorfromrgb(215,219,213) GraphicsWindow.brushcolor=chrome tri[3] = Shapes.Addtriangle(585,405,585,420,450,390) Shapes.Move(tri[3], 0,0) GraphicsWindow.BrushColor="#000000" tri[4] = Shapes.Addtriangle(350,445,230,445,350,385) Shapes.Move(tri[4], 0,0) ' piston cylinder GraphicsWindow.brushcolor=chrome rec[12] = Shapes.Addrectangle(150,20) Shapes.Move(rec[12], 585,405) rec[13] = Shapes.Addrectangle(90,30) Shapes.Move(rec[13], 360,380) ' 1 lines GraphicsWindow.pencolor=chrome GraphicsWindow.penwidth= 2 line[1] = Shapes.Addline(615,120,500,120) Shapes.Move(line[1], -150,170) EndSub End>QRB861.sb< Start>QRC070-0.sb< ' Draw Cuboid ' Version 0.2 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-0 ' GraphicsWindow.Title = "Draw Cuboid 0.2" GraphicsWindow.BackgroundColor = "LightGray" threepoint = "True" debug = "False" Init() ' test If debug Then sx = 2 sy = 1 sz = 1 Map2D() param = "x=2;y=2;z=2;color=Blue;" DrawVoxel() param = "x=1;y=2;z=2;color=Blue;" DrawVoxel() While "True" Program.Delay(200) EndWhile sx = 21 sy = 20 sz = 20 Map2D() sx = 21 sy = 21 sz = 20 Map2D() sx = 21 sy = 20 sz = 21 Map2D() sx = 20 sy = 20 sz = 21 Map2D() While "True" Program.Delay(200) EndWhile param = "x=18;y=18;z=19;color=Yellow;" DrawVoxel() While "True" Program.Delay(200) EndWhile EndIf ' buildings param = "x=12;y=3;width=3;height=7;depth=1;" For z = 10 To 0 Step -1 If Math.Remainder(z, 2) = 0 Then param["color"] = "Blue" Else param["color"] = "Transparent" EndIf param["z"] = z DrawCuboid() EndFor param = "x=6;y=3;width=5;height=10;depth=1;" For z = 10 To 2 Step -1 If Math.Remainder(z, 2) = 0 Then param["color"] = "White" Else param["color"] = "Transparent" EndIf param["z"] = z DrawCuboid() EndFor ' car param = "x=4;y=4;z=10;color=Black;" DrawVoxel() param = "x=2;y=4;z=10;color=Black;" DrawVoxel() param = "x=4;y=7;z=10;color=Black;" DrawVoxel() param = "x=2;y=7;z=10;color=Black;" DrawVoxel() param = "x=2;y=4;z=9;width=3;height=5;depth=1;color=Red;" DrawCuboid() param = "x=4;y=3;z=9;color=Yellow;" DrawVoxel() param = "x=3;y=3;z=9;color=Red;" DrawVoxel() param = "x=2;y=3;z=9;color=Yellow;" DrawVoxel() param = "x=2;y=4;z=8;width=3;height=1;depth=1;color=Transparent;" DrawCuboid() ' person param = "x=0;y=0;z=10;color=Blue;" DrawVoxel() param = "x=0;y=0;z=9;color=Yellow;" DrawVoxel() Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = gw / 2 yo = gh / 2 u = 20 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-0.sb< Start>QRC070-1.sb< GraphicsWindow.Title = "CubWorld" GraphicsWindow.BackgroundColor = "LightGray" Init() LDUtilities.ShowErrors="false args=0 ss=30 ' buildings param = "x=2;y=-4;width=5;height=10;depth=1;color=1;z=1" For z = 0 To 12 If Math.Remainder(z, 2) = 0 Then param["color"] = "Blue" Else param["color"] = "Cyan" EndIf param["z"] = z DrawCuboid () EndFor param = "x=6;y=3;width=5;height=5;depth=1;color=1;z=1" For z = 0 To 10 If Math.Remainder(z, 2) = 0 Then param["color"] = "Yellow" Else param["color"] = "Orange EndIf param["z"] = z DrawCuboid () EndFor param="y=-2;x=4;z=0;color=darkblue param["x"] = 10 param["color"] = "Red For z=-1 to 5 param["z"] = z For y=2 to 5-z param["y"] = y DrawVoxel() EndFor endfor ob=2 objmd="true pc=1 ' car dy=15 dx=6 par = "y=-2;x=4;z=0;color=darkblue|y=-4;x=4;z=0|y=-2;x=1;z=0|y=-4;x=1;z=0 dvox() param = "y="+(dy-4)+";x="+dx+";z=1;width=3;height=5;depth=1;color=Red DrawCuboid() par = "y=-4;x=5;z=1;color=Yellow|y=-3;x=5;z=1;color=Red|y=-2;x=5;z=1;color=Yellow dvox() param = "y="+(dy-4)+";x="+(4+dx)+";z=2;width=3;height=1;depth=1;color=Orange;" DrawCuboid() ' person ob=1 pc=1 pc=1 dy=-1 dx=2 param = "x=9;y=9;z=0;color=Blue DrawVoxel() param = "x=9;y=9;z=1;color=Magenta DrawVoxel() ccx=9 ccy=9 ccz=0 ldcall.Function3("Conv3Dto2D",ccx ccy ccz) ox=cx oy=cy p300=350 ccy=ccy-1 ccz=ccz+1 ldcall.Function3("Conv3Dto2D",ccx ccy ccz) dx=cx-ox dy=cy-oy Program.Delay (1111) ii=1 ldcall.Function3 ("smove",dx,dy,5) ldcall.Function3 ("smove",-dx,-dy,5) ccx=9 ccz=0 ccy=10 ldcall.Function3("Conv3Dto2D",ccx ccy ccz) dx=cx-ox dy=cy-oy ldcall.Function3 ("smove",dx,dy,6) ccx=9 ccy=15 ccz=0 ldcall.Function3("Conv3Dto2D",ccx ccy ccz) ox=cx oy=cy ccx=8 ccy=15 ccz=0 ldcall.Function3("Conv3Dto2D",ccx ccy ccz) dx=cx-ox dy=cy-oy ldcall.Function3 ("smove",dx,dy,3) For qq=1 to 6 Shapes.HideShape (po[1][qq]) endfor ii=2 p300=110 ldcall.Function3 ("smove",-dx,-dy,25) Sub smove For tt=1 to args[3] for w=1 to Array.GetItemCount (po[ii]) Shapes.Move(po[ii][w],Shapes.GetLeft(po[ii][w])+args[1],Shapes.Gettop(po[ii][w])+args[2]) endfor Program.Delay(p300) endfor EndSub Sub dvox pa=LDText.Split (par,"|") For r=1 to Array.GetItemCount (pa) param=pa[r] DrawVoxel() endfor EndSub Sub drawvoxel LDCall.Function5 ("drawcube" param["x"]+dx param["y"]+dy param["z"] 30 param["color"]) EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["height"] + xmin - 1 ymax = param["width"] + ymin - 1 zmax = param["depth"] + zmin - 1 sColor = param["color"] For _z = zmin To zmax For _y = ymin To ymax For _x = xmin To xmax LDCall.Function5("drawcube",_x _y _z 30 sColor ) EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub Conv3Dto2D cx = gw / 2 - Math.SquareRoot(1 / 2) * args[1]*ss cx = cx + Math.SquareRoot(1 / 2) * args[2]*ss cy = gh / 2 + Math.SquareRoot(1 / 6) * args[1]*ss cy = cy + Math.SquareRoot(1 / 6) * args[2]*ss cy = cy - Math.SquareRoot(2 / 3) * args[3]*ss EndSub Sub Color_RGBtoHSL rHue=LDColours.GetHue (sColor) rLightness=LDColours.GetLightness(sColor ) rSaturation=LDColours.GetSaturation (sColor ) EndSub Sub DrawCube lz=args[3] xx=args[1] yy=args[2] Conv3Dto2D() edge = Math.SquareRoot(2 / 3) * args[4] x1 = math.Round (cx) y1 = math.Round (cy) sColor = args[5] ccc=ldcolours.GetHue(scolor) For i=1 To 3 color[i] = LDColours.HSLtoRGB(ccc 1 .8/Math.Power(1.5 i)) EndFor GraphicsWindow.PenWidth =0 x3=0 x4=0 y3=0 y4=0 For a = 60 To 420 Step 60 x2 = math.Round (cx - edge * ldMath.Sin(a)) y2 = math.Round (cy - edge * ldMath.Cos(a)) If a>60 and math.Remainder ((a-60),120)=0 Then ppp=0 ppp[1][1]=x1+50 ppp[1][2]=y1-30 ppp[2][1]=x2+50 ppp[2][2]=y2-30 ppp[3][1]=x3+50 ppp[3][2]=y3-30 ppp[4][1]=x4+50 ppp[4][2]=y4-30 of=1 If objmd then po[ob][pc]=LDShapes.AddPolygon (ppp) LDShapes.BrushColour(po[ob][pc],color[(a-60)/120]) pc=pc+1 else br=LDShapes.BrushGradient("1="+color[(a-60) / 120]+";2="+color[(a-60) / 120],"V") LDShapes.BrushPolygon (br,ppp) endif EndIf x4 = x3 y4 = y3 x3 = x2 y3 = y2 EndFor EndSub Sub Init gw = 800 gh = 800 GraphicsWindow.BackgroundColor ="teal GraphicsWindow.Left =10 GraphicsWindow.top=10 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = gw / 2 yo = gh * 3 / 4 u = 20 r = u * Math.SquareRoot(2 / 3) a60 = Math.GetRadians(60) EndSub End>QRC070-1.sb< Start>QRC070-2.sb< ' Draw Cuboid ' Version 0.31 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-2 ' GraphicsWindow.Title = "Draw Cuboid 0.31" GraphicsWindow.BackgroundColor = "LightGray" threepoint = "True" debug = "False" Init() ground = 21 ' building param = "x=6;y=18;width=5;height=3;floor=6;color=White;" Building() ' bridge hb = 3 param = "x=16;y=14;z=" + (ground - hb) + ";width=3;height=3;depth=" + hb + ";color=Gray;" DrawCuboid() param = "x=15;y=14;z=" + (ground - hb - 1) + ";width=5;height=3;depth=1;color=Gray;" DrawCuboid() param = "x=6;y=14;z=" + (ground - hb) + ";width=3;height=3;depth=" + hb + ";color=Gray;" DrawCuboid() param = "x=5;y=14;z=" + (ground - hb - 1) + ";width=5;height=3;depth=1;color=Gray;" DrawCuboid() ' rails param = "x=0;y=16;z=" + (ground - hb - 2) + ";width=25;height=1;depth=1;color=Blue;" DrawCuboid() param = "x=0;y=14;z=" + (ground - hb - 2) + ";width=25;height=1;depth=1;color=Blue;" DrawCuboid() ' train param = "x=13;y=14;z=" + (ground - hb - 6) + ";color=#33FF33;" Train() param = "x=0;y=14;z=" + (ground - hb - 6) + ";color=#33FF33;" Train() ' buildings param = "x=16;y=3;width=7;height=7;floor=3;color=White;" Building() param = "x=12;y=3;width=3;height=7;floor=6;color=Blue;" Building() param = "x=6;y=3;width=5;height=10;floor=4;color=White;" Building() ' cars param = "x=2;y=10;color=Red;" Car() param = "x=2;y=3;color=Gray;" Car() ' people param = "x=20;y=0;color=Gray;" Person() param = "x=7;y=0;color=Black;" Person() param = "x=0;y=9;color=Blue;" Person() param = "x=0;y=2;color=Red;" Person() param = "x=0;y=0;color=Blue;" Person() Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = gw / 2 yo = 0.25 * gh u = 20 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = 1.5 * gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub Car xSave = param["x"] ySave = param["y"] colorSave = param["color"] param = "x=" + (xSave + 2) + ";y=" + (ySave + 1) + ";z=" + (ground - 1) + ";color=Black;" DrawVoxel() param = "x=" + xSave + ";y=" + (ySave + 1) + ";z=" + (ground - 1) + ";color=Black;" DrawVoxel() param = "x=" + (xSave + 2) + ";y=" + (ySave + 4) + ";z=" + (ground - 1) + ";color=Black;" DrawVoxel() param = "x=" + xSave + ";y=" + (ySave + 4) + ";z=" + (ground - 1) + ";color=Black;" DrawVoxel() param = "x=" + xSave + ";y=" + (ySave + 1) + ";z=" + (ground - 2) + ";width=3;height=5;depth=1;color=" + colorSave + ";" DrawCuboid() param = "x=" + (xSave + 2) + ";y=" + ySave + ";z=" + (ground - 2) + ";color=White;" DrawVoxel() param = "x=" + (xSave + 1) + ";y=" + ySave + ";z=" + (ground - 2) + ";color=" + colorSave + ";" DrawVoxel() param = "x=" + xSave + ";y=" + ySave + ";z=" + (ground - 2) + ";color=White;" DrawVoxel() param = "x=" + xSave + ";y=" + (ySave + 1) + ";z=" + (ground - 3) + ";width=3;height=1;depth=1;color=Transparent;" DrawCuboid() EndSub Sub Building param["depth"] = 1 colorSave = param["color"] For z = ground - 1 To ground - 2 * param["floor"] - 1 Step -1 If Math.Remainder(z, 2) = 0 Then param["color"] = colorSave Else param["color"] = "Transparent" EndIf param["z"] = z DrawCuboid() EndFor EndSub Sub Person param["z"] = ground - 1 DrawVoxel() param["z"] = ground - 2 param["color"] = "Yellow" DrawVoxel() EndSub Sub Train xSave = param["x"] ySave = param["y"] zSave = param["z"] colorSave = param["color"] param = "x=" + (xSave + 1) + ";y=" + ySave + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 1) + ";y=" + (ySave + 2) + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 3) + ";y=" + ySave + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 3) + ";y=" + (ySave + 2) + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 8) + ";y=" + ySave + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 8) + ";y=" + (ySave + 2) + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 10) + ";y=" + ySave + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + (xSave + 10) + ";y=" + (ySave + 2) + ";z=" + (zSave + 3) + ";color=Gray;" DrawVoxel() param = "x=" + xSave + ";y=" + ySave + ";z=" + (zSave + 2) + ";width=12;height=3;depth=1;color=" + colorSave + ";" DrawCuboid() param = "x=" + xSave + ";y=" + ySave + ";z=" + (zSave + 1) + ";width=12;height=3;depth=1;color=Transparent;" DrawCuboid() param = "x=" + xSave + ";y=" + ySave + ";z=" + zSave + ";width=12;height=3;depth=1;color=" + colorSave + ";" DrawCuboid() EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-2.sb< Start>QRC070-3.sb< ' Draw Cuboid ' Version 0.4 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-3 ' GraphicsWindow.Title = "Draw Cuboid 0.4" GraphicsWindow.BackgroundColor = "White" threepoint = "True" debug = "False" Init() param = "x=6;y=5;z=0;width=6;height=6;depth=6;color=#FF6600" DrawCuboid() param = "x=0;y=6;z=2;width=5;height=5;depth=5;color=#00CCFF;" DrawCuboid() param = "x=4;y=0;z=3;width=4;height=4;depth=4;color=#00FF33;" DrawCuboid() Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = 0.45 * gw yo = 0.66 * gh u = 30 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = 4 * gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-3.sb< Start>QRC070-4.sb< ' Draw Cuboid ' Version 0.6 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-4 ' GraphicsWindow.Title = "Draw Cuboid 0.6" GraphicsWindow.BackgroundColor = "LightGray" threepoint = "False" debug = "False" Init() size = 7 psize = 6 z = 18 param["color"] = "Gray" ' stairs param["depth"] = size * 2 + 2 param["height"] = psize param["width"] = Math.Ceiling(size / 2) * psize ' back param["x"] = Math.Floor(size / 2) * psize param["y"] = (size - 1) * psize param["z"] = z - 3 DrawCuboid() param["depth"] = 1 param["height"] = psize param["y"] = (size - 1) * psize For i = Math.Floor(size / 2) To size param["width"] = (size - i) * psize ' back param["x"] = i * psize param["z"] = z - i DrawCuboid() EndFor param["depth"] = size * 2 param["height"] = (size - 1) * psize param["width"] = psize ' left param["x"] = (size - 1) * psize param["y"] = 0 param["z"] = z - 1 DrawCuboid() param["depth"] = size - 1 param["width"] = psize ' left param["height"] = (size - 1) * psize param["x"] = (size - 1) * psize param["y"] = 0 param["z"] = z - size + 1 DrawCuboid() param["depth"] = 1 For i = 1 To size param["height"] = (size - i) * psize param["z"] = z - i - size + 1 DrawCuboid() EndFor param["width"] = psize ' right param["height"] = psize For i = Math.Floor(size / 2) To 1 Step -1 param["depth"] = size * 5 + i - 4 param["x"] = 0 param["y"] = psize * i param["z"] = z - i - (size - 1) * 3 DrawCuboid() EndFor param["depth"] = size * 4 - 2 param["width"] = (size - 1) * psize ' front param["height"] = psize param["x"] = 0 param["y"] = 0 param["z"] = z - size * 2 + 1 DrawCuboid() param["depth"] = 1 For i = 1 To size param["width"] = (size - i) * psize param["z"] = z - i - size * 2 + 2 DrawCuboid() EndFor Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = 0.5 * gw yo = 0.5 * gh u = 8 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = 2 * gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-4.sb< Start>QRC070-5.sb< ' Draw Cuboid ' Version 0.7 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-5 ' GraphicsWindow.Title = "Draw Cuboid 0.7" GraphicsWindow.BackgroundColor = "DimGray" threepoint = "False" debug = "False" Init() size = 9 param["color"] = "LightGray" ' stairs param["depth"] = 1 param["height"] = size - 1 param["width"] = 1 param["x"] = size - 1 param["y"] = 1 param["z"] = size - 1 DrawCuboid() param["depth"] = size param["height"] = 1 param["width"] = 1 param["x"] = size - 1 param["y"] = 0 param["z"] = 0 DrawCuboid() param["depth"] = 1 param["height"] = 1 param["width"] = size - 3 param["x"] = 2 param["y"] = 0 param["z"] = 0 DrawCuboid() param["x"] = 1 param["y"] = 0 param["z"] = 0 DrawHalfVoxel() Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = 0.7 * gw yo = 0.5 * gh u = 40 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = 2 * gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) a120 = Math.GetRadians(120) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawHalfVoxel CalcColors() x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 + ru / 2 * Math.Sin(-a120) y3 = y0 - ru / 2 * Math.Cos(-a120) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 + ru / 2 * Math.Sin(-a120) y3 = y0 - ru / 2 * Math.Cos(-a120) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-5.sb< Start>QRC070-6.sb< ' Draw Cuboid ' Version 0.8 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRC070-6 ' GraphicsWindow.Title = "Draw Cuboid 0.8" GraphicsWindow.BackgroundColor = "#333333" threepoint = "True" debug = "False" Init() size = 6 ' color cube param["depth"] = size param["height"] = size param["width"] = size param["x"] = 0 param["y"] = 0 param["z"] = 0 While "True" For level = 3 * (size - 1) To 0 Step -1 DrawColorCube() Program.Delay(1000) EndFor GraphicsWindow.BrushColor = "#333333" GraphicsWIndow.FillRectangle(0, 0, gw, gh) EndWhile Sub Init UNDEFINED = "N/A" gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh xo = 0.5 * gw yo = 0.46 * gh u = 40 ru = u * Math.SquareRoot(2 / 3) If threepoint THen rv = 2 * gw Else rv = "∞" EndIf a60 = Math.GetRadians(60) a120 = Math.GetRadians(120) Colors_Init() vx["x"] = xo + rv * Math.Sin(-a60) vx["y"] = yo - rv * Math.Cos(-a60) vy["x"] = xo + rv * Math.Sin(a60) vy["y"] = yo - rv * Math.Cos(a60) vz["x"] = xo vz["y"] = yo + rv EndSub Sub CalcColors color = param["color"] If color = "Transparent" Then transparent = "True" color = "Black" Else transparent = "False" EndIf Color_NameToRGB() colorLeft = color Color_RGBtoHSL() savedLightness = lightness lightness = Math.Min(savedLightness * 1.2, 1) Color_HSLtoRGB() colorTop = color lightness = Math.Max(savedLightness * 0.8, 0) Color_HSLtoRGB() colorRight = color If transparent Then colorTop = "#66" + Text.GetSubTextToEnd(colorTop, 2) colorLeft = "#66" + Text.GetSubTextToEnd(colorLeft, 2) colorRight = "#66" + Text.GetSubTextToEnd(colorRight, 2) EndIf EndSub Sub CalcVertex ' Calcurate vertex between line p1-p2 and line p3-p4 a = p1["x"] * p2["y"] - p1["y"] * p2["x"] b = p1["y"] - p2["y"] c = p1["x"] - p2["x"] d = p3["x"] * p4["y"] - p3["y"] * p4["x"] e = p3["y"] - p4["y"] f = p3["x"] - p4["x"] If b = 0 Then p["y"] = a / c p["x"] = (f * p["y"] - d) / e ElseIf c = 0 Then p["x"] = -a / b p["y"] = (e * p["x"] + d) / f Else p["x"] = ((a * f) - (c * d)) / ((c * e) - (b * f)) p["y"] = (a + b * p["x"]) / c EndIF EndSub Sub DrawColorCube Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 For _z = zmax To zmin Step -1 param["z"] = _z cz = Math.Floor(255 * (zmax - _z) / zmax) For _y = ymax To ymin Step -1 param["y"] = _y cy = Math.Floor(255 * (ymax - _y) / ymax) For _x = xmax To xmin Step -1 cx = Math.Floor(255 * (xmax - _x) / xmax) param["x"] = _x param["color"] = GraphicsWindow.GetColorFromRGB(cx, cy, cz) If _x + _y + _z = level Then DrawVoxel() Program.Delay(100) EndIf EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawCuboid Stack.PushValue("local", param) xmin = param["x"] ymin = param["y"] zmin = param["z"] xmax = param["width"] + xmin - 1 ymax = param["height"] + ymin - 1 zmax = param["depth"] + zmin - 1 param = "color=" + param["color"] + ";" For _z = zmax To zmin Step -1 param["z"] = _z For _y = ymax To ymin Step -1 param["y"] = _y For _x = xmax To xmin Step -1 param["x"] = _x DrawVoxel() EndFor EndFor EndFor param = Stack.PopValue("local") EndSub Sub DrawVoxel CalcColors() If rv = "∞" Then x0 = xo + ru * Math.Sin(a60) * param["y"] + ru * Math.Sin(-a60) * param["x"] y0 = yo - ru * Math.Cos(a60) * param["y"] + ru * param["z"] - ru * Math.Cos(-a60) * param["x"] GraphicsWindow.BrushColor = colorTop x1 = x0 y1 = y0 - ru x2 = x0 + ru * Math.Sin(-a60) y2 = y0 - ru * Math.Cos(-a60) x3 = x0 + ru * Math.Sin(a60) y3 = y0 - ru * Math.Cos(a60) GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(a60) y2 = y0 - ru * Math.Cos(a60) x3 = x0 y3 = y0 GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(-a60) y1 = y0 - ru * Math.Cos(-a60) x2 = x0 + ru * Math.Sin(-2 * a60) y2 = y0 - ru * Math.Cos(-2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 y2 = y0 x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = x0 + ru * Math.Sin(a60) y1 = y0 - ru * Math.Cos(a60) x2 = x0 + ru * Math.Sin(2 * a60) y2 = y0 - ru * Math.Cos(2 * a60) x3 = x0 y3 = y0 + ru GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) Else GraphicsWindow.BrushColor = colorTop sx = param["x"] + 1 sy = param["y"] + 1 sz = param["z"] Map2D() pxy = p sx = param["x"] + 1 sy = param["y"] sz = param["z"] Map2D() px = p sx = param["x"] sy = param["y"] + 1 sz = param["z"] Map2D() py = p sx = param["x"] sy = param["y"] sz = param["z"] Map2D() po = p x1 = pxy["x"] y1 = pxy["y"] x2 = px["x"] y2 = px["y"] x3 = py["x"] y3 = py["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = py["x"] y2 = py["y"] x3 = po["x"] y3 = po["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorLeft sx = param["x"] + 1 sy = param["y"] sz = param["z"] + 1 Map2D() pxz = p sx = param["x"] sy = param["y"] sz = param["z"] + 1 Map2D() pz = p x1 = px["x"] y1 = px["y"] x2 = pxz["x"] y2 = pxz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = px["x"] y1 = px["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) GraphicsWindow.BrushColor = colorRight sx = param["x"] sy = param["y"] + 1 sz = param["z"] + 1 Map2D() pyz = p x1 = py["x"] y1 = py["y"] x2 = po["x"] y2 = po["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) x1 = py["x"] y1 = py["y"] x2 = pyz["x"] y2 = pyz["y"] x3 = pz["x"] y3 = pz["y"] GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3) EndIf EndSub Sub Map2D ' param sx, sy, sz ≧ 0 ' return p["x"], p["y"] k = (rv - ru) / (rv + ru) If sx = 0 Then rx = 0 Else rx = Math.Power(1 + k, Math.Log(sx) / Math.Log(2)) * ru EndIf If sy = 0 Then ry = 0 Else ry = Math.Power(1 + k, Math.Log(sy) / Math.Log(2)) * ru EndIf If sz = 0 Then rz = 0 Else rz = Math.Power(1 + k, Math.Log(sz) / Math.Log(2)) * ru EndIf If debug Then TextWIndow.WriteLine("sz=" + sz) TextWIndow.WriteLine("logsz=" + Math.Log(sz)) TextWindow.WriteLine("rx=" + rx) TextWindow.WriteLine("ry=" + ry) TextWindow.WriteLine("rz=" + rz) EndIf _px["x"] = xo + rx * Math.Sin(-a60) _px["y"] = yo - rx * Math.Cos(-a60) If debug Then GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(xo, yo, _px["x"], _px["y"]) EndIf _py["x"] = xo + ry * Math.Sin(a60) _py["y"] = yo - ry * Math.Cos(a60) If debug Then GraphicsWindow.DrawLine(xo, yo, _py["x"], _py["y"]) EndIf _pz["x"] = xo _pz["y"] = yo + rz If debug Then GraphicsWindow.DrawLine(xo, yo, _pz["x"], _pz["y"]) EndIf p1 = _px p2 = vy p3 = _py p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_py["x"], _py["y"], p["x"], p["y"]) EndIf _pxy = p p1 = _px p2 = vz p3 = _pz p4 = vx CalcVertex() If debug Then GraphicsWindow.DrawLine(_px["x"], _px["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pz["x"], _pz["y"], p["x"], p["y"]) EndIf _pxz = p p1 = _pxz p2 = vy p3 = _pxy p4 = vz CalcVertex() If debug Then GraphicsWindow.DrawLine(_pxy["x"], _pxy["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(_pxz["x"], _pxz["y"], p["x"], p["y"]) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] - 5, p["x"] + 5, p["y"] + 5) GraphicsWindow.DrawLine(p["x"] - 5, p["y"] + 5, p["x"] + 5, p["y"] - 5) bc = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(p["x"], p["y"], "(" + sx + "," + sy + "," + sz + ")") GraphicsWindow.BrushColor = bc EndIf EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param hue - [0, 360) or UNDEFINED ' param lightness - [0, 1] ' param saturation - [0, 1] ' return color - "#rrggbb" If lightness <= 0.5 Then n2 = lightness * (1 + saturation) Else n2 = lightness + saturation - lightness * saturation EndIf n1 = 2 * lightness - n2 If saturation = 0 Then r = Math.Round(lightness * 255) g = Math.Round(lightness * 255) b = Math.Round(lightness * 255) Else h = hue + 120 Color_Value() r = value h = hue Color_Value() g = value h = hue - 120 Color_Value() b = value EndIf color = GraphicsWindow.GetColorFromRGB(r, g, b) EndSub Sub Color_NameToRGB ' Color | Convert Color to RGB ' param color - color name ' returns color -"#rrggbb" If Text.StartsWith(color, "#") Then color = Text.ConvertToUpperCase(color) Else color = Text.ConvertToLowerCase(color) color = colors[color] EndIf EndSub Sub Color_Value ' Color | Function value ' param n1, n2 ' param h - [-120, 480) ' return value - 0..255 If h >= 360 Then h = h - 360 EndIF If h < 0 Then h = h + 360 EndIF If h < 60 Then v = n1 + (n2 - n1) * h / 60 ElseIf h < 180 Then v = n2 ElseIf h < 240 Then v = n1 + (n2 - n1) * (240 - h) / 60 Else v = n1 EndIf value = Math.Round(v * 255) EndSub Sub Color_RGBtoGray ' Color | Convert RGB to Gray ' param color - "#rrggbb" ' return brightness - (0, 1) ' return gray - "#rrggbb" Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() r = dec hex = sG Math_Hex2Dec() g = dec hex = sB Math_Hex2Dec() b = dec min = Math.Min(Math.Min(r, g), b) level = min + Math.Round(((r - min) * 2 + (g - min) * 4 + (b - min) * 1 ) / 7) brightness = Math.Round(level / 255 * 10000) / 10000 gray = GraphicsWindow.GetColorFromRGB(level, level, level) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param color - "#rrggbb" ' return hue - [0, 360) or UNDEFINED ' return lightness - (0, 1) ' return saturation - (0, 1) Color_NameToRGB() sR = Text.GetSubText(color, 2, 2) sG = Text.GetSubText(color, 4, 2) sB = Text.GetSubText(color, 6, 2) hex = sR Math_Hex2Dec() ' r = dec / 255 ' occurs Math.Max() bug r = Math.Round(dec / 255 * 10000) / 10000 hex = sG Math_Hex2Dec() ' g = dec / 255 ' occurs Math.Max() bug g = Math.Round(dec / 255 * 10000) / 10000 hex = sB Math_Hex2Dec() ' b = dec / 255 ' occurs Math.Max() bug b = Math.Round(dec / 255 * 10000) / 10000 max = Math.Max(r, g) max = Math.Max(max, b) min = Math.Min(r, g) min = Math.Min(min, b) lightness = (max + min) / 2 If max = min Then ' r = g = b saturation = 0 hue = UNDEFINED Else If lightness <= 0.5 Then saturation = (max - min) / (max + min) Else saturation = (max - min) / (2 - max - min) EndIf rc = (max - r) / (max - min) gc = (max - g) / (max - min) bc = (max - b) / (max - min) If r = max Then ' between Yellow and Magenta hue = bc - gc ElseIf g = max Then ' between Cyan and Yellow hue = 2 + rc - bc ElseIf b = max Then ' between Magenta and Cyan hue = 4 + gc - rc Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("max=" + max) TextWindow.WriteLine("r=" + r + ",sR=" + sR) TextWindow.WriteLine("g=" + g + ",sG=" + sG) TextWindow.WriteLine("b=" + b + ",sB=" + sB) EndIf hue = hue * 60 If hue < 0 Then hue = hue + 360 EndIf EndIf EndSub Sub Color_GrayFromLightness ' Color | Gray from lightness ' param lightness - 0..255 ' return gray - "#rrggbb" iGray = Math.Round(lightness * 255) gray = GraphicsWindow.GetColorFromRGB(iGray, iGray, iGray) EndSub Sub Colors_Init colors["aliceblue"]="#F0F8FF" colors["antiquewhite"]="#FAEBD7" colors["aqua"]="#00FFFF" colors["aquamarine"]="#7FFFD4" colors["azure"]="#F0FFFF" colors["beige"]="#F5F5DC" colors["bisque"]="#FFE4C4" colors["black"]="#000000" colors["blanchedalmond"]="#FFEBCD" colors["blue"]="#0000FF" colors["blueviolet"]="#8A2BE2" colors["brown"]="#A52A2A" colors["burlywood"]="#DEB887" colors["cadetblue"]="#5F9EA0" colors["chartreuse"]="#7FFF00" colors["chocolate"]="#D2691E" colors["coral"]="#FF7F50" colors["cornflowerblue"]="#6495ED" colors["cornsilk"]="#FFF8DC" colors["crimson"]="#DC143C" colors["cyan"]="#00FFFF" colors["darkblue"]="#00008B" colors["darkcyan"]="#008B8B" colors["darkgoldenrod"]="#B8860B" colors["darkgray"]="#A9A9A9" colors["darkgreen"]="#006400" colors["darkkhaki"]="#BDB76B" colors["darkmagenta"]="#8B008B" colors["darkolivegreen"]="#556B2F" colors["darkorange"]="#FF8C00" colors["darkorchid"]="#9932CC" colors["darkred"]="#8B0000" colors["darksalmon"]="#E9967A" colors["darkseagreen"]="#8FBC8F" colors["darkslateblue"]="#483D8B" colors["darkslategray"]="#2F4F4F" colors["darkturquoise"]="#00CED1" colors["darkviolet"]="#9400D3" colors["deeppink"]="#FF1493" colors["deepskyblue"]="#00BFFF" colors["dimgray"]="#696969" colors["dodgerblue"]="#1E90FF" colors["firebrick"]="#B22222" colors["floralwhite"]="#FFFAF0" colors["forestgreen"]="#228B22" colors["fuchsia"]="#FF00FF" colors["gainsboro"]="#DCDCDC" colors["ghostwhite"]="#F8F8FF" colors["gold"]="#FFD700" colors["goldenrod"]="#DAA520" colors["gray"]="#808080" colors["green"]="#008000" colors["greenyellow"]="#ADFF2F" colors["honeydew"]="#F0FFF0" colors["hotpink"]="#FF69B4" colors["indianred"]="#CD5C5C" colors["indigo"]="#4B0082" colors["ivory"]="#FFFFF0" colors["khaki"]="#F0E68C" colors["lavender"]="#E6E6FA" colors["lavenderblush"]="#FFF0F5" colors["lawngreen"]="#7CFC00" colors["lemonchiffon"]="#FFFACD" colors["lightblue"]="#ADD8E6" colors["lightcoral"]="#F08080" colors["lightcyan"]="#E0FFFF" colors["lightgoldenrodyellow"]="#FAFAD2" colors["lightgray"]="#D3D3D3" colors["lightgreen"]="#90EE90" colors["lightpink"]="#FFB6C1" colors["lightsalmon"]="#FFA07A" colors["lightseagreen"]="#20B2AA" colors["lightskyblue"]="#87CEFA" colors["lightslategray"]="#778899" colors["lightsteelblue"]="#B0C4DE" colors["lightyellow"]="#FFFFE0" colors["lime"]="#00FF00" colors["limegreen"]="#32CD32" colors["linen"]="#FAF0E6" colors["magenta"]="#FF00FF" colors["maroon"]="#800000" colors["mediumaquamarine"]="#66CDAA" colors["mediumblue"]="#0000CD" colors["mediumorchid"]="#BA55D3" colors["mediumpurple"]="#9370DB" colors["mediumseagreen"]="#3CB371" colors["mediumslateblue"]="#7B68EE" colors["mediumspringgreen"]="#00FA9A" colors["mediumturquoise"]="#48D1CC" colors["mediumvioletred"]="#C71585" colors["midnightblue"]="#191970" colors["mintcream"]="#F5FFFA" colors["mistyrose"]="#FFE4E1" colors["moccasin"]="#FFE4B5" colors["navajowhite"]="#FFDEAD" colors["navy"]="#000080" colors["oldlace"]="#FDF5E6" colors["olive"]="#808000" colors["olivedrab"]="#6B8E23" colors["orange"]="#FFA500" colors["orangered"]="#FF4500" colors["orchid"]="#DA70D6" colors["palegoldenrod"]="#EEE8AA" colors["palegreen"]="#98FB98" colors["paleturquoise"]="#AFEEEE" colors["palevioletred"]="#DB7093" colors["papayawhip"]="#FFEFD5" colors["peachpuff"]="#FFDAB9" colors["peru"]="#CD853F" colors["pink"]="#FFC0CB" colors["plum"]="#DDA0DD" colors["powderblue"]="#B0E0E6" colors["purple"]="#800080" colors["red"]="#FF0000" colors["rosybrown"]="#BC8F8F" colors["royalblue"]="#4169E1" colors["saddlebrown"]="#8B4513" colors["salmon"]="#FA8072" colors["sandybrown"]="#F4A460" colors["seagreen"]="#2E8B57" colors["seashell"]="#FFF5EE" colors["sienna"]="#A0522D" colors["silver"]="#C0C0C0" colors["skyblue"]="#87CEEB" colors["slateblue"]="#6A5ACD" colors["slategray"]="#708090" colors["snow"]="#FFFAFA" colors["springgreen"]="#00FF7F" colors["steelblue"]="#4682B4" colors["tan"]="#D2B48C" colors["teal"]="#008080" colors["thistle"]="#D8BFD8" colors["tomato"]="#FF6347" colors["turquoise"]="#40E0D0" colors["violet"]="#EE82EE" colors["wheat"]="#F5DEB3" colors["white"]="#FFFFFF" colors["whitesmoke"]="#F5F5F5" colors["yellow"]="#FFFF00" colors["yellowgreen"]="#9ACD32" EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param hex ' return dec dec = 0 len = Text.GetLength(hex) For ptr = 1 To len dec = dec * 16 + Text.GetIndexOf("123456789ABCDEF", Text.GetSubText(hex, ptr, 1)) EndFor EndSub End>QRC070-6.sb< Start>QRC674.sb< 'program by YLED ' September 5th 2016 ' september SB challenge multitasking ' program no: path=Program.Directory GraphicsWindow.Title = " SKY REAL TIME " GraphicsWindow.top= 0 GraphicsWindow.left= 0 GraphicsWindow.Height= 200 GraphicsWindow.Width = 300 image=ImageList.LoadImage("https://social.msdn.microsoft.com/Forums/getfile/931724") rock = Shapes.AddImage(image) Shapes.HideShape(rock) Shapes.Move (rock,120,100) Shapes.ShowShape(rock) While 1=1 For N=931725 To 931729 sky[N]=ImageList.LoadImage("https://social.msdn.microsoft.com/Forums/getfile/"+N) ' sky[N]=ImageList.LoadImage(Path+"\images\"+N+".JPG") GraphicsWindow.DrawImage(sky[N], 0, 0) Shapes.animate(rock,120,100-K,800) Shapes.Rotate(rock,45+K*1.1) Program.Delay(150) K=K+1 EndFor EndWhile End>QRC674.sb< Start>QRC904.sb< 'Written by Thaelmann-Pioniere init() writename() For i = 1 To 5 If i>2 Then color1="Black" color2=color1 ElseIf i=2 Then color1=color2 color2="Black" EndIf drawatom() x[i]=Turtle.X y[i]=Turtle.Y drawbond() Turtle.Turn(72) EndFor Turtle.Angle=0 For i = 1 To 5 If i<2 Or i>2 Then Turtle.PenUp() Turtle.MoveTo(x[i],y[i]) Turtle.PenDown() For i2 = 1 To 2 Turtle.PenDown() Turtle.TurnLeft() color1="Black" color2="White" drawbond() drawatom() Turtle.Turn(180) Turtle.PenUp() drawbond() EndFor EndIf EndFor Sub init r=20 d=r*2 GraphicsWindow.Title="Molecular Challenge-Oxolane(C9H8O)" GraphicsWindow.Width=600 GraphicsWindow.Height=Desktop.Height GraphicsWindow.BackgroundColor="#dabc72" GraphicsWindow.PenWidth=15 Turtle.Speed=10 Turtle.PenUp() Turtle.MoveTo(300,350) Turtle.Angle=54 color1="black" color2="red" GraphicsWindow.PenColor="black" Turtle.PenDown() EndSub Sub writename GraphicsWindow.FontBold="false" GraphicsWindow.FontName="Times New Roman" GraphicsWindow.BrushColor="White" GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(400,20,"C") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(440,50,"4") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(460,20,"H") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(500,50,"8") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(520,20,"O") EndSub Sub drawatom GraphicsWindow.BrushColor=GraphicsWindow.PenColor GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) EndSub Sub drawbond GraphicsWindow.PenColor=color1 Turtle.Move(r+20) GraphicsWindow.PenColor=color2 Turtle.Move(20+r) EndSub End>QRC904.sb< Start>QRH345.sb< ' Challenge of month Oct. 2013 Progress bar by NaochanON GraphicsWindow.Hide() GraphicsWindow.Width=800 GraphicsWindow.Height=200 getbar() GraphicsWindow.Show() Timer.Tick = OnTimerTick Timer.Interval=1000 Sub OnTimerTick count=count+1 len= Math.Remainder(count,10) GraphicsWindow.Title=" Count= "+len If len=0 Then getbar() Shapes.SetText(msg[NN-1],count) Else Shapes.SetOpacity(bar[NN],80) Shapes.Zoom(bar[NN],len/10,1) Shapes.Move(bar[NN],50+len/10*50+(NN-1)*100,50) Shapes.SetText(msg[NN],count) Shapes.Zoom(msg[NN],len/5,1) Shapes.Move(msg[NN],90+len/10*30+(NN-1)*100,50) EndIf EndSub Sub getbar NN=NN+1 If NN=7 Then For i=1 To 6 Shapes.Remove(bar[i]) Shapes.Remove(msg[i]) EndFor NN=1 count=0 EndIf color= GraphicsWindow.GetRandomColor() GraphicsWindow.BrushColor=color GraphicsWindow.PenColor=color bar[NN]=Shapes.AddRectangle(100,100) Shapes.Move(bar[NN],-500,50) GraphicsWindow.BrushColor="red" GraphicsWindow.FontSize=30 msg[NN]= Shapes.AddText(" ") Shapes.Move(msg[NN],-500,50) endsub End>QRH345.sb< Start>QRQ360.sb< 'BrickWall 'A development of the paddle game sample. 'Revove all the bricks to complete the game. ' Game over if you miss the ball. 'You are penalised -1 each time no bricks are hit. 'The movement of the ball is influenced by where it hits the paddle. 'Do not let the bricks reach the bottom of the screen. GameStart: 'paddle = GraphicsWindow.AddRectangle(120, 12) 'v0.2 paddle = Shapes.AddRectangle(120, 12) 'v0.3.1 'ball = GraphicsWindow.AddEllipse(16, 16) 'v0.2 ball = Shapes.AddEllipse(16,16) 'v0.3.1 bricksLeft = 48 brickStartY = 35 hitCount = 0 GraphicsWindow.FontSize = 14 GraphicsWindow.MouseMove = OnMouseMove GraphicsWindow.Title = "Brick Wall" For idx = 0 To 15 Array.SetValue("GreenBricks", idx, 1) Array.SetValue("YellowBricks", idx, 1) Array.SetValue("RedBricks", idx, 1) Endfor DrawBricks() score = 0 PrintScore() gw = GraphicsWindow.Width gh = GraphicsWindow.Height y = gh - 28 'GraphicsWindow.MoveShape(ball, x, y) 'v0.2 Shapes.Move(ball,x,y) 'v0.3.1 deltaX = 1 deltaY = -2 Sound.PlayBellRingAndWait() RunLoop: x = x + deltaX y = y + deltaY gw = GraphicsWindow.Width gh = GraphicsWindow.Height If (x >= gw - 16 Or x <= 0) Then deltaX = -deltaX EndIf If (y <= 0) Then deltaY = -deltaY EndIf 'padX = GraphicsWindow.GetLeftOfShape(paddle) 'v0.2 padX = Shapes.GetLeft(paddle) 'v0.3.1 If ((y >= gh - 28 + 2) And x >= padX And x <= padX + 120) Then y = gh - 28 + 2 'Sound.PlayClick() hitCount = hitCount + 1 If Math.Remainder(hitCount, 3) = 0 Then 'Move bricks downwards For idx = 0 To 15 RemoveGreenBrick() RemoveYellowBrick() RemoveRedBrick() Endfor brickStartY = brickStartY + 20 DrawBricks() EndIf TestRed: For idx = 0 To 15 If Array.GetValue("RedBricks", idx) = 1 Then If brickStartY > gh - 160 Then Goto EndGame EndIf EndIf EndFor TestYellow: For idx = 0 To 15 If Array.GetValue("YellowBricks", idx) = 1 Then If brickStartY > gh - 100 Then Goto EndGame EndIf EndIf EndFor TestGreen: For idx = 0 To 15 If Array.GetValue("GreenBricks", idx) = 1 Then If brickStartY > gh - 40 Then Goto EndGame EndIf EndIf EndFor EndTest: deltaX = deltaX - 2 + (x - padX) / 30 ' Add some skill If score = oldScore Then 'No bricks hit score = score - 1 EndIf oldScore = score PrintScore() deltaY = -deltaY 'Change the ball direction EndIf ' GraphicsWindow.MoveShape(ball, x, y) 'v0.2 Shapes.Move(ball,x,y) 'v0.3.1 Program.Delay(5) ' Green Bricks If y > brickStartY - 16 And y < brickStartY + 20 Then ' y position of brick - diameter of ball idx = (x+8) / 40 ' Radius of ball / length of brick idx = Math.Floor(idx) ' take integer part If Array.GetValue("GreenBricks", idx) = 1 Then Array.SetValue("GreenBricks", idx, 0) RemoveGreenBrick() Sound.PlayChime() bricksLeft = bricksLeft - 1 deltaY = -deltaY 'Change ball direction score = score + 15 PrintScore() CheckEnd() EndIf EndIf ' Yellow Bricks If y > brickStartY + 44 And y < brickStartY + 80 Then ' y position of brick - diameter of ball = 19 idx = (x+8) / 40 ' Radius of ball / length of brick idx = Math.Floor(idx) ' take integer part If Array.GetValue("YellowBricks", idx) = 1 Then Array.SetValue("YellowBricks", idx, 0) RemoveYellowBrick() Sound.PlayChime() bricksLeft = bricksLeft - 1 deltaY = -deltaY 'Change ball direction score = score + 10 PrintScore() CheckEnd() EndIf EndIf ' Red Bricks If y > brickStartY + 104 And y < brickStartY + 140 Then ' y position of brick - diameter of ball = 19 idx = (x+8) / 40 ' Radius of ball / length of brick idx = Math.Floor(idx) ' take integer part If Array.GetValue("RedBricks", idx) = 1 Then Array.SetValue("RedBricks", idx, 0) RemoveRedBrick() Sound.PlayChime() bricksLeft = bricksLeft - 1 deltaY = -deltaY 'Change ball direction score = score + 5 PrintScore() CheckEnd() EndIf EndIf If (y < gh) Then 'Ball not reached bottom of window Goto RunLoop EndIf EndGame: GraphicsWindow.ShowMessage("Your score is: " + score, "BrickWall") Program.End() Sub OnMouseMove paddleX = GraphicsWindow.MouseX ' GraphicsWindow.MoveShape(paddle, paddleX - 60, GraphicsWindow.Height - 12) 'v0.2 Shapes.Move(paddle, paddleX - 60, GraphicsWindow.Height - 12) 'v0.3.1 EndSub Sub PrintScore ' Clear the score first and then draw the real score text GraphicsWindow.BrushColor = "White" GraphicsWindow.FillRectangle(10, 10, 200, 20) GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(10, 10, "Score: " + score) EndSub Sub DrawBricks For idx = 0 To 15 ' Draw bricks 'Program.Delay(100) If Array.GetValue("GreenBricks", idx) = 1 Then GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "Green" Else GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" EndIf GraphicsWindow.FillRectangle(idx * 40, brickStartY, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY, 40, 20) GraphicsWindow.BrushColor = "Yellow" If Array.GetValue("YellowBricks", idx) = 1 Then GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "Yellow" Else GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" EndIf GraphicsWindow.FillRectangle(idx * 40, brickStartY + 60, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY + 60, 40, 20) GraphicsWindow.BrushColor = "Red" If Array.GetValue("RedBricks", idx) = 1 Then GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "Red" Else GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" EndIf GraphicsWindow.FillRectangle(idx * 40, brickStartY + 120, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY + 120, 40, 20) endfor EndSub Sub RemoveGreenBrick GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" GraphicsWindow.FillRectangle(idx * 40, brickStartY, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY, 40, 20) EndSub Sub RemoveYellowBrick GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" GraphicsWindow.FillRectangle(idx * 40, brickStartY + 60, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY + 60, 40, 20) EndSub Sub RemoveRedBrick GraphicsWindow.PenColor = "White" GraphicsWindow.BrushColor = "White" GraphicsWindow.FillRectangle(idx * 40, brickStartY + 120, 40, 20) GraphicsWindow.DrawRectangle(idx * 40, brickStartY + 120, 40, 20) EndSub Sub CheckEnd If bricksLeft = 0 Then GraphicsWindow.ShowMessage("Well Done. Wall destroyed. Your score is: " + score, "BrickWall") 'Goto GameStart Program.End() 'Goto EndGame EndIf EndSub End>QRQ360.sb< Start>QRR040.sb< ' Challenge of the month March 2013 -- Graphical scales -- by NaochanON ' Now this program is on processing GraphicsWindow.MouseMove=onmove GraphicsWindow.MouseDown=onmousedown GraphicsWindow.MouseUp=onmouseup Shapes_Init() balance() Sub moveweight sumw1=0 sumw4=0 For jj=1 To 4 sumw4=sumw4+W4[jj] Shapes.Move(shape[(W4[jj]*jj+7)],Shapes.GetLeft(shape[6]["obj"])+60,Shapes.GetTop(shape[6]["obj"])-40*sumw4) endfor EndSub Sub falling w4x=Shapes.GetLeft(shape[w4nmb+7]) ' w4 X-position w4y=Shapes.Gettop(shape[w4nmb+7]) ' w4 Y-position newBX=Shapes.GetLeft(shape[6]["obj"]) ' base X-position If newBXstartL+10+DDL Then startL=L ' change start swing DDL=DDL+10 ' add swing time +10 wangle0=((4*sumw4+sumw1)*BL-(bx0-bx1)*8)/((bx0-bx1)*8)*30 ' angle of the balance GraphicsWindow.Title="angle= "+wangle0 ElseIf L=startL+10+DDL Then L=0 startL=0 ' change start swing DDL=0 ' add swing time +10 wangle0=((4*sumw4+sumw1)*BL-(bx0-bx1)*8)/((bx0-bx1)*8)*30 ' angle of the balance GraphicsWindow.Title="angle= "+wangle0 balance() EndIf Else W4[w4NMB]=0 Shapes.Animate(shape[w4nmb+7],w4x,1000,2000) endif EndSub Sub onmove MX= GraphicsWindow.MouseX MY= GraphicsWindow.MouseY If catch4="true" Then Shapes.Move(shape[w4nmb+7],MX-20,MY-20) elseIf catch1="true" Then Shapes.Move(shape[w1nmb+11],MX-10,MY-10) endif EndSub Sub onmousedown MX= GraphicsWindow.MouseX MY= GraphicsWindow.MouseY GraphicsWindow.Title="Scale ...... Catch Error" If (shx+580QRR040.sb< Start>QRS755-0.sb< ' mahreen miangul Animate Move and Fire MaY 2017 ' Animate Sprite S-W-A-T-F SpaceBar ' Cannon Move and Fire XZ F ' Animate Man ArrowKeys GraphicsWindow.top=0 GraphicsWindow.left=0 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Width = "1288" GraphicsWindow.Height = "666" GraphicsWindow.BackgroundColor="rosybrown" '--------------------Font Animation ----------------------------------------------------------------------------------------- GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 77 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "lightyellow" ' Text shadow color GraphicsWindow.DrawText(285, 5, "mahreen miangul!")' Shadow position/text gold= GraphicsWindow.getcolorfromrgb(121,94,40) GraphicsWindow.BrushColor = gold ' Text color GraphicsWindow.DrawText(280, 0, "mahreen miangul!") ' Position and text GraphicsWindow.KeyDown = onkeyDown x=0 Shapes_Init() Shapes_Add() GraphicsWindow.BrushColor = "slateblue" cannon1_x = 333 cannon1_y = 566 cannon = Shapes.AddRectangle(50,100) Shapes.Move(cannon, cannon1_x, cannon1_y) SPRITE_init() ' <--------- all shape data is input here!! add_shapes() ' <--------- all shapes are added here!! dX=0 ' initial Human moving speed-X dY=0 ' initial Human moving speed-Y GraphicsWindow.BrushColor="darkslategray" Ball=Shapes.AddEllipse(40,40) Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) Shapes.HideShape(Ball) Timer.Interval=1000 '<---------- Timer.Tick=duck_up '<---------- 'Animate Cycle dZ = 0.1 zoom = 1 ddx=0 ' initial cycle moving speed-X ddy=0 ' initial cycle moving speed-Y bdx=0 ' initial ball moving speed-X bdy=10 ' initial ball moving speed-Y NMB="5:1" ' Cycle shapes number=5 repeat =1 shoot="False" While 0=0 ' Blinking   zoom = zoom - dZ   For i = 1 To Array.GetItemCount(shape[5]) ' Cycle shapes number=5     If Array.ContainsValue(shape[5][i], "eye") Then       Shapes.Zoom(shp[NMB][i], 1, zoom)     ElseIf Array.ContainsValue(shape[5][i], "mouth") Then       Shapes.Zoom(shp[NMB][i], zoom, zoom)     EndIf shapes.Move(shp[NMB][i],shapes.GetLeft(shp[NMB][i])+ddx,shapes.Gettop(shp[NMB][i])+ddy) EndFor   If zoom = 0.1 Or zoom = 1 Then     dZ = -dZ   EndIf ' cycle reverse moving X,Y direction cycleX= shapes.GetLeft(shp[NMB][3]) ' = face cycleY= shapes.GetTop(shp[NMB][3]) If cycleX<0 Or cycleX>GraphicsWindow.Width-shape[5][3]["width"] Then ddx=-ddx EndIf If cycleY<0 Or cycleY>cannon1_y-shape[5][3]["height"] Then ddy=-ddy EndIf ' ball moving and collision check If shoot Then shapes.Move(Ball ,shapes.GetLeft(ball)+angle/4,shapes.Gettop(ball)-bdy) If shapes.Gettop(ball)<-100 then shoot="False" Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) Shapes.HideShape(Ball) EndIf ' collision check here ballX=shapes.GetLeft(ball) bally=shapes.GetTop(ball) If (cycleXkey Then counts=0 Lastangles=initangles EndIf Shapes_Move() ElseIf Text.IsSubText("Up:Down",key) Then ds="X=0;y="+KLST[key] Shapes_Move() EndIf lastkey=Key ' Keys........ S, W, A, T, X,Z,F , SpaceBar and arrow keys work 'Sub OnKeyDown key= GraphicsWindow.LastKey If key="S" Then ddx=4 ElseIf Key="W"then ddx=-4 ElseIf Key="A"then ddy=4 ElseIf key="T"Then ddy=-4 ElseIf key="Space" Then ddx=0 ddy=0 EndIf If shoot="False" Then If Key = "X" Then angle=angle+1 Shapes.Rotate(cannon,angle) ElseIf Key = "Z" Then angle=angle-1 Shapes.Rotate(cannon,angle) ElseIf Key="F" then Shapes.ShowShape(Ball) shoot="True" EndIf endif EndSub Sub Shapes_Move Multi=1.8 counts=counts+1 For i=1 To posnmb x[i]=shapes.GetLeft(shp[i][1]) ' each position -X y[i]=shapes.Gettop(shp[i][1]) ' each position -Y If text.IsSubText(inmbs,":"+i+":") Then x[i]=shapes.GetLeft(shp[i-1][pos[i-1]["NN"]]) ' upper arm/leg last number -X y[i]=shapes.Gettop(shp[i-1][pos[i-1]["NN"]]) ' upper arm/leg last number -Y EndIf MM= Math.Ceiling(2*counts/div) GraphicsWindow.Title=MM+" : "+counts Dangle=PM[MM]*angles[Key][NMB[MM]][i]/div ' dθ/div thisangle=Lastangles[i]+ Multi*Dangle ' current each angle dx=pos[i]["wd"]*math.sin(math.GetRadians(thisangle)) dy=pos[i]["wd"]*math.cos(math.GetRadians(thisangle)) for j=1 To pos[i]["NN"] Shapes.Move(shp[i][j],x[i]+ds["X"]+(j-1)*dx,y[i]+ds["Y"]+(j-1)*dy) ' arms / legs EndFor Lastangles[i]=thisangle EndFor if counts>div*2-1 Then counts=0 EndIf endsub Sub duck_up ' duck body rotate Timer.Pause() For k=1 To Array.GetItemCount(s[4]) ' k=1 to 7 Shapes.Rotate(SHP["4:"+k][8],-25) ' <-------------- rotating angle // body = 8 // ducks index="4:1" to "4:7" endfor Program.Delay(300) For k=1 To Array.GetItemCount(s[4]) ' k=1 to 7 Shapes.Rotate(SHP["4:"+K][8], 0) ' <-------------- rotating angle // body = 8// ducks index="4:1" to "4:7" EndFor Program.Delay(300) Timer.Resume() endsub Sub add_shapes For M=1 to Array.GetItemCount(s) ' 7 types shapes //Human , House, Tree, duck , cycle, Apple , Bee For N=1 to Array.GetItemCount(s[M]) ' repeat number //Human=1 ,House=1 ,Tree=12, duck=7 , cycle=1, Apple=16 , Bee=1 ss=s[M][N] ' scale _shx=shx[M][N] ' base point _X _shY=shY[M][N] ' base point _Y _shape=shape[M] ' temporary shape data NMB=M+":"+N ' shape index for i=1 To Array.GetItemCount(_shape) GraphicsWindow.PenWidth = _shape[i]["pw"] GraphicsWindow.BrushColor = _shape[i]["bc"] GraphicsWindow.penColor = _shape[i]["pc"] If _shape[i]["func"]="ell" Then shp[NMB][i] = Shapes.AddEllipse(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="rect" Then shp[NMB][i] = Shapes.AddRectangle(_shape[i]["width"]*ss, _shape[i]["height"]*ss) ElseIf _shape[i]["func"]="tri" Then shp[NMB][i] = Shapes.Addtriangle(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss, _shape[i]["x3"]*ss, _shape[i]["y3"]*ss) ElseIf _shape[i]["func"]="line" Then '<---- shp[NMB][i] = Shapes.Addline(_shape[i]["x1"]*ss, _shape[i]["y1"]*ss,_shape[i]["x2"]*ss, _shape[i]["y2"]*ss) EndIf Shapes.Animate(shp[NMB][i], _shape[i]["x"]*ss+_shX, _shape[i]["y"]*ss+_shY, 500) Shapes.Rotate(shp[NMB][i], _Shape[i]["angle"]) EndFor endfor endfor EndSub Sub SPRITE_init ' Donkey Kong s[1] ="1=.5" shX[1] ="1=650" shY[1] ="1=520" shape[1][1] = "func=ell;x=98;y=44;width=110;height=71;bc=#834216;pw=0;" shape[1][2] = "func=ell;x=51;y=247;width=75;height=23;angle=348;bc=#FDBC90;pc=#834216;pw=2;" shape[1][3] = "func=ell;x=197;y=250;width=74;height=22;angle=11;bc=#FDBC90;pc=#834216;pw=2;" shape[1][4] = "func=ell;x=113;y=253;width=20;height=22;bc=#FDBC90;pc=#834216;pw=2;" shape[1][5] = "func=ell;x=191;y=255;width=18;height=20;bc=#FDBC90;pc=#834216;pw=2;" shape[1][6] = "func=ell;x=40;y=260;width=13;height=16;bc=#FDBC90;pc=#834216;pw=2;" shape[1][7] = "func=ell;x=47;y=264;width=16;height=18;bc=#FDBC90;pc=#834216;pw=2;" shape[1][8] = "func=ell;x=261;y=267;width=13;height=13;bc=#FDBC90;pc=#834216;pw=2;" shape[1][9] = "func=ell;x=252;y=269;width=13;height=15;bc=#FDBC90;pc=#834216;pw=2;" shape[1][10] = "func=ell;x=81;y=190;width=36;height=67;angle=332;bc=#834216;pw=0;" shape[1][11] = "func=ell;x=200;y=188;width=35;height=67;angle=20;bc=#834216;pw=0;" shape[1][12] = "func=ell;x=76;y=175;width=62;height=43;bc=#834216;pw=0;" shape[1][13] = "func=ell;x=171;y=178;width=60;height=40;bc=#834216;pw=0;" shape[1][14] = "func=ell;x=112;y=139;width=82;height=76;bc=#834216;pw=0;" shape[1][15] = "func=ell;x=75;y=99;width=81;height=72;bc=#834216;pw=0;" shape[1][16] = "func=ell;x=149;y=96;width=82;height=74;bc=#834216;pw=0;" shape[1][17] = "func=ell;x=5;y=87;width=107;height=55;angle=340;bc=#834216;pw=0;" shape[1][18] = "func=ell;x=195;y=82;width=109;height=59;angle=25;bc=#834216;pw=0;" shape[1][19] = "func=ell;x=0;y=126;width=43;height=76;angle=341;bc=#834216;pw=0;" shape[1][20] = "func=ell;x=263;y=126;width=45;height=72;angle=17;bc=#834216;pw=0;" shape[1][21] = "func=ell;x=33;y=176;width=39;height=35;bc=#FDBC90;pc=#834216;pw=2;" shape[1][22] = "func=ell;x=239;y=176;width=41;height=37;bc=#FDBC90;pc=#834216;pw=2;" shape[1][23] = "func=tri;x=113;y=0;x1=37;y1=0;x2=0;y2=76;x3=75;y3=76;bc=#834216;pw=0;" shape[1][24] = "func=tri;x=148;y=5;x1=15;y1=0;x2=0;y2=43;x3=31;y3=43;bc=#834216;pw=0;" shape[1][25] = "func=ell;x=110;y=46;width=58;height=41;angle=33;bc=#FDBC90;pw=0;" shape[1][26] = "func=ell;x=138;y=47;width=61;height=41;angle=318;bc=#FDBC90;pw=0;" shape[1][27] = "func=tri;x=119;y=60;x1=33;y1=0;x2=0;y2=41;x3=67;y3=41;angle=180;bc=#000000;pc=#000000;pw=2;" shape[1][28] = "func=ell;x=127;y=61;width=28;height=19;angle=349;bc=#FFFFFF;pc=#000000;pw=2;" shape[1][29] = "func=ell;x=152;y=62;width=30;height=20;angle=16;bc=#FFFFFF;pc=#000000;pw=2;" shape[1][30] = "func=ell;x=135;y=66;width=14;height=15;bc=#000000;pc=#000000;pw=2;" shape[1][31] = "func=ell;x=158;y=67;width=14;height=15;bc=#000000;pc=#000000;pw=2;" shape[1][32] = "func=ell;x=123;y=140;width=59;height=60;bc=#FCA76E;pc=#834216;pw=2;" shape[1][33] = "func=ell;x=150;y=107;width=62;height=55;bc=#FCA76E;pw=0;" shape[1][34] = "func=ell;x=94;y=107;width=64;height=53;bc=#FCA76E;pw=0;" shape[1][35] = "func=ell;x=96;y=79;width=118;height=69;bc=#FDBC90;pc=#834216;pw=2;" shape[1][36] = "func=ell;x=77;y=65;width=35;height=23;angle=38;bc=#FDBC90;pc=#834216;pw=2;" shape[1][37] = "func=ell;x=194;y=63;width=36;height=23;angle=317;bc=#FDBC90;pc=#834216;pw=2;" shape[1][38] = "func=ell;x=130;y=74;width=22;height=17;angle=15;bc=#FDBC90;pw=0;" shape[1][39] = "func=ell;x=156;y=73;width=22;height=18;angle=348;bc=#FDBC90;pw=0;" shape[1][40] = "func=tri;x=111;y=90;x1=10;y1=0;x2=0;y2=22;x3=20;y3=22;angle=298;bc=#FFFFFF;pc=#000000;pw=2;" shape[1][41] = "func=tri;x=172;y=91;x1=11;y1=0;x2=0;y2=23;x3=22;y3=23;angle=62;bc=#FFFFFF;pc=#000000;pw=2;" shape[1][42] = "func=rect;x=125;y=97;width=55;height=21;bc=#FFFFFF;pc=#000000;pw=2;" shape[1][43] = "func=ell;x=135;y=78;width=15;height=9;angle=23;bc=#834216;pw=0;" shape[1][44] = "func=ell;x=159;y=77;width=15;height=9;angle=339;bc=#834216;pw=0;" shape[1][45] = "func=line;x=152;y=97;x1=0;y1=0;x2=0;y2=19;pc=#000000;pw=2;" shape[1][46] = "func=line;x=137;y=98;x1=0;y1=0;x2=0;y2=19;pc=#000000;pw=2;" shape[1][47] = "func=line;x=167;y=99;x1=0;y1=0;x2=0;y2=18;pc=#000000;pw=2;" ' House s[2] ="1=3" shX[2] ="1=-280" shY[2] ="1=120" shape[2][1] = "func=rect;x=230;y=50;width=80;height=40;bc=skyblue;pc=darkslategray;pw=1"'Rec A4 shape[2][2] = "func=rect;x=240;y=60;width=20;height=30;bc=orange;pc=darkslategray;pw=1"'Rec A3 shape[2][3] = "func=rect;x=280;y=60;width=20;height=20;bc=lightblue;pc=darkslategray;pw=2"'Rec A2 shape[2][4] = "func=tri;x=0;y=0;x1=230;y1=50;x2=270;y2=10;x3=310;y3=50;bc=silver;pc=darkslategray;pw=2"'Tri A1 shape[2][5] = "func=rect;x=300;y=20;width=10;height=30;bc=gray;pc=darkslategray;pw=2"'Tri A2 ' Trees 12 s[3]="1=0.8;2=.8;3=.8;4=.8;5=.8;6=.8;7=.8;8=.8;9=.8;10=.8;11=.8;12=.8" shX[3]="1=-20;2=70;3=150;4=150;5=480;6=800;7=988;8=644;9=777;10=866;11=966;12=1088"" shY[3]="1=200;2=120;3=112;4=300;5=300;6=300;7=300;8=100;9=80;10=70;11=80;12=100" shape[3][1]="func=ell;X=0;Y=188;width=200;height=140;bc=Green;pc=Green;pw=2" shape[3][2]="func=ell;X=10;Y=277;width=80;height=60;bc=Green;pc=Green;pw=2 shape[3][3]="func=ell;X=4;Y=255;width=80;height=70;bc=Green;pc=Green;pw=2 shape[3][4]="func=ell;X=0;Y=191;width=80;height=80;bc=Green;pc=Green;pw=2 shape[3][5]="func=ell;X=40;Y=177;width=80;height=80;bc=Green;pc=Green;pw=2 shape[3][6]="func=ell;X=100;Y=177;width=120;height=80;bc=Green;pc=Green;pw=2 shape[3][7]="func=ell;X=130;Y=240;width=100;height=80;bc=Green;pc=Green;pw=2 shape[3][8]="func=ell;X=130;Y=260;width=100;height=80;bc=Green;pc=Green;pw=2 shape[3][9]="func=rect;X=80;Y=322;width=60;height=100;bc=saddlebrown;pc=darkslatgray;pw=2 shape[3][10]="func=tri;X1=140;Y1=262;X2=110;Y2=322;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 shape[3][11]="func=tri;X1=140;Y1=262;X2=170;Y2=262;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 shape[3][12]="func=tri;X1=50;Y1=262;X2=96;Y2=262;X3=80;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 shape[3][13]="func=tri;X1=96;Y1=262;X2=80;Y2=322;X3=126;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0 ' Ducks 7 s[4] ="1=.2;2=.2;3=.2;4=.2;5=.2;6=.2;7=.2" shX[4]="1=460;2=440;3=500;4=500;5=540;6=580;7=440" shY[4]="1=180;2=200;3=160;4=200;5=210;6=210;7=220" shape[4][1] = "func=tri;x=153;y=41;x1=47;y1=0;x2=0;y2=22;x3=95;y3=22;bc=red;pw=0;beck" shape[4][2] = "func=ell;x=118;y=0;width=91;height=73;bc=blue;pw=0;" shape[4][3] = "func=line;x=172;y=36;x1=0;y1=0;x2=22;y2=0;pc=red;pw=2;blink" shape[4][4] = "func=ell;x=172;y=25;width=22;height=22;bc=pink;pw=0;eye" shape[4][5] = "func=tri;x=132;y=58;x1=31;y1=0;x2=0;y2=45;x3=62;y3=45;bc=red;pw=0;neck" shape[4][6] = "func=tri;x=0;y=80;x1=37;y1=0;x2=0;y2=32;x3=75;y3=32;angle=178;bc=red;pw=0;tail" shape[4][7] = "func=line;x=91;y=134;x1=0;y1=0;x2=0;y2=36;pc=red;pw=8;Leg1" shape[4][8] = "func=ell;x=33;y=72;width=164;height=82;bc=yellow;pw=0;body" shape[4][9] = "func=tri;x=58;y=180;x1=46;y1=0;x2=0;y2=14;x3=93;y3=14;bc=red;pw=0;Leg3" shape[4][10] = "func=line;x=90;y=169;x1=0;y1=0;x2=14;y2=15;pc=yellow;pw=8;Leg2" ' Santa & reindeer/Sprite s[5] = "1=0.7" shX[5]= "1=980" shY[5]= "1=10" shape[5][1] = "func=ell;x=28;y=110;width=120;height=58;bc=#814a27;pw=0" shape[5][2] = "func=rect;x=36;y=144;width=9;height=65;bc=#814a27;pw=0" shape[5][3] = "func=rect;x=49;y=143;width=9;height=65;bc=#814a27;pw=0" shape[5][4] = "func=rect;x=99;y=143;width=9;height=65;bc=#814a27;pw=0" shape[5][5] = "func=rect;x=113;y=143;width=9;height=65;bc=#814a27;pw=0" shape[5][6] = "func=rect;x=32;y=78;width=24;height=47;bc=#814a27;pw=0" shape[5][7] = "func=ell;x=140;y=115;width=18;height=20;bc=#814a27;pw=0" shape[5][8] = "func=rect;x=43;y=36;width=7;height=30;bc=#a7842a;pw=0" shape[5][9] = "func=rect;x=53;y=43;width=7;height=30;bc=#a7842a;pw=0" shape[5][10] = "func=rect;x=33;y=18;width=7;height=30;angle=-60;bc=#a7842a;pw=0" shape[5][11] = "func=rect;x=63;y=23;width=7;height=30;angle=60;bc=#a7842a;pw=0" shape[5][12] = "func=rect;x=20;y=0;width=7;height=30;bc=#a7842a;pW=0" shape[5][13] = "func=rect;x=75;y=3;width=7;height=30;bc=#a7842a;pw=0" shape[5][14] = "func=rect;x=29;y=109;width=27;height=7;bc=#000000;pw=2" shape[5][15] = "func=ell;x=21;y=112;width=18;height=18;bc=#c3ab6f;;pw=0" shape[5][16] = "func=rect;x=157;y=198;width=241;height=9;bc=#8c8c8c;pw=0" shape[5][17] = "func=rect;x=177;y=178;width=9;height=23;bc=#8c8c8c;pw=0" shape[5][18] = "func=rect;x=369;y=178;width=9;height=23;bc=#8c8c8c;pw=0" shape[5][19] = "func=rect;x=150;y=184;width=9;height=23;angle=-40;bc=#8c8c8c;pw=0" shape[5][20] = "func=rect;x=61;y=111;width=9;height=52;bc=#000000;pw=0" shape[5][21] = "func=rect;x=65;y=136;width=111;height=9;bc=#000000;pw=0" shape[5][22] = "func=ell;x=310;y=80;width=70;height=70;bc=#ebe4d0;pw=0" ' white toys bag shape[5][23] = "func=ell;x=237;y=81;width=85;height=90;bc=#9d1010;pw=0" ' red body shape[5][24] = "func=ell;x=255;y=50;width=40;height=50;bc=#ebe4d0;pw=0" ' white face shape[5][25] = "func=rect;x=258;y=61;width=33;height=21;bc=#dbb9a9;pw=0" ' pink face shape[5][26] = "func=ell;x=274;y=72;width=11;height=12;bc=#9d1010;pw=0" ' nose shape[5][27] = "func=ell;x=264;y=64;width=12;height=12;bc=#000000;pw=0;tag=eye" ' eye 1 <------ shape[5][28] = "func=ell;x=285;y=64;width=12;height=12;bc=#000000;pw=0;tag=eye" ' eye 2 <------ shape[5][29] = "func=rect;x=263;y=40;width=32;height=14;angle=13;bc=#9d1010;pw=0" 'red cap 1 shape[5][30] = "func=rect;x=265;y=34;width=36;height=13;bc=#9d1010;pw=0" ' red cap 2 shape[5][31] = "func=ell;x=295;y=30;width=18;height=20;bc=#ebe4d0;pw=0" 'white cap 3 shape[5][32] = "func=rect;x=255;y=82;width=10;height=45;angle=-22;bc=#ebe4d0;pw=0"' white strip 1 shape[5][33] = "func=rect;x=275;y=82;width=10;height=63;angle=22;bc=#ebe4d0;pw=0" ' white strip 2 shape[5][34] = "func=rect;x=176;y=136;width=202;height=43;bc=#563a1a;pw=0" ' cart shape[5][35] = "func=ell;x=205;y=60;width=25;height=25;bc=#ebe4d0;pw=0" ' white fingers shape[5][36] = "func=rect;x=207;y=77;width=26;height=34;angle=-10;bc=#9d1010;pw=0" ' red arm shape[5][37] = "func=rect;x=216;y=83;width=26;height=34;angle=-90;bc=#9d1010;pw=0" ' red shoulder shape[5][38] = "func=ell;x=11;y=65;width=55;height=20;bc=#814a27;pw=0" shape[5][39] = "func=ell;x=32;y=65;width=14;height=14;bc=#000000;pw=0;tag=eye" ' <------ shape[5][40] = "func=ell;x=4;y=68;width=14;height=14;bc=#9d1010;pw=0;tag=mouth" ' <------ shape[5][41] = "func=ell;x=52;y=65;width=28;height=10;angle=-20;bc=#814a27;pw=0" ' Apples 16 s[6] ="1=0.2;2=0.2;3=0.2;4=0.2;5=0.2;6=0.2;7=0.2;8=0.2;9=0.2;10=0.2;11=0.2;12=0.2;13=0.2;14=0.2;15=0.2;16=0.2" shX[6] ="1=-60;2=60;3=140;4=140;5=444;6=600;7=700;8=800;9=900;10=1000;11=1080;12=1000;13=740;14=920;15=720;16=820" shY[6] ="1=360;2=260;3=270;4=444;5=440;6=240;7=220;8=240;9=220;10=240;11=220;12=420;13=420;14=420;15=480;16=480" shape[6][1] = "func=rect;x=626;y=110;width=20;height=60;angle=30;bc=yellowgreen;pw=0;" shape[6][2] = "func=ell;x=511;y=148;width=150;height=150;bc=crimson;pw=0;" shape[6][3] = "func=ell;x=603;y=148;width=150;height=150;bc=crimson;pw=0;" shape[6][4] = "func=ell;x=594;y=188;width=40;height=40;bc=snow;pw=0;" shape[6][5] = "func=ell;x=633;y=188;width=40;height=40;bc=snow;pw=0;" shape[6][6] = "func=ell;x=614;y=196;width=15;height=15;bc=darkslategray;pw=0;" shape[6][7] = "func=ell;x=635;y=196;width=15;height=15;angle=7;bc=darkslategray;pw=0;" shape[6][8] = "func=rect;x=600;y=250;width=80;height=20;angle=-5;bc=purple;pw=0;" '1 Kaleidoscope/mahreen miangul s[7] ="1=0.8" ' scale shx[7] ="1=-160" ' initial x -position shy[7] ="1=-160" ' initial y-position shape[7][1] = "func=tri;x1=366;y1=250;x2=411;y2=280;x3=366;y3=310;bc=gold;angle=0;pw=2;tag=head" shape[7][2] = "func=tri;x1=585;y1=405;x2=585;y2=420;x3=450;y3=390;bc=mediumslateblue;angle=0;pw=2;tag=tri2" shape[7][3] = "func=tri;x1=350;y1=445;x2=230;y2=445;x3=350;y3=385;bc=mediumslateblue;angle=0;pw=2;tag=tri1" shape[7][4] = "func=rect;x=585;y=405;width=150;height=20;bc=darkslategray;angle=0;tag=rectback" shape[7][5] = "func=rect;x=360;y=380;width=90;height=30;bc=darkslategray;angle=0;tag=rectfron" endsub ' Man Running Sub Shapes_Init X0 = 350 Y0 = 120 pos[1] = "x=0;y=0;wd=50;NN=1;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' Head pos[2] = "x=19;y=50;wd=10;NN=10;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' body 50,12 pos[3] = "x=13;y=55;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' left arm upper 55,6 pos[4] = "x=13;y=115;wd=10;NN=5;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' left arm lower 55+10*6,6 pos[5] = "x=16;y=150;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' Left leg upper 50+10*12,6 pos[6] = "x=16;y=210;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' Left leg lower 50+10*12+10*6,5 pos[7] = "x=25;y=55;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' Right arm upper 55,6 pos[8] = "x=25;y=115;wd=10;NN=5;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' Right arm lower 55+10*6,5 pos[9] = "x=20;y=150;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' right leg upper 50+10*12,6 pos[10] = "x=20;y=210;wd=10;NN=6;angle=0;bc=#AABBFF;pc=#000000;pw=2;" ' right leg lower 50+10*12+10*6,5 '---------------------------------------------------------------------------------------------------------------- posnmb= Array.GetItemCount(pos) KLST="Right=3;Left=-3;Up=-2;Down=2" '------------------------------------ Left to Right direction ------------------------------------------------------- angles["Right"][1]="1=0;2=0;3=-90;4=-40;5=-80;6=-150;7=90;8=180;9=120;10=20" ' Right direction pause *** angles["Right"][2]="1=0;2=0;3=90;4=180;5=120;6=20;7=-85;8=-40;9=-80;10=-150" ' Left direction pause *** '------------------------------------ Right to Left direction ------------------------------------------------------- angles["Left"][1]="1=0;2=0;3=-60;4=-120;5=-80;6=-35;7=90;8=20;9=85;10=120" ' Right direction pause angles["Left"][2]="1=0;2=0;3=90;4=20;5=85;6=120;7=-60;8=-120;9=-80;10=-35" ' Left direction pause '---------------------------------------------------------------------------------------------------------------- div=20 Gravity=9.8 inmbs="2:4:6:8:10:" PM="1=1;2=-1;3=1;4=-1" NMB="1=1;2=1;3=2;4=2" Lastangles="1=0;2=0;3=0;4=0;5=0;6=0;7=0;8=0;9=0;10=0" ' Standing pause initangles=lastangles EndSub Sub Shapes_Add GraphicsWindow.Width=1288 GraphicsWindow.Height=666 For i = 1 To Array.GetItemCount(pos) GraphicsWindow.Penwidth = pos[i]["pw"] GraphicsWindow.PenColor = pos[i]["pc"] GraphicsWindow.BrushColor = pos[i]["bc"] For j=1 To pos[i]["NN"] shp[i][j]=Shapes.AddEllipse(pos[i]["wd"],pos[i]["wd"]) dx= pos[i]["wd"]*math.sin(math.GetRadians(pos[i]["angle"])) dy= pos[i]["wd"]*math.cos(math.GetRadians(pos[i]["angle"])) sx[i][j]= X0+pos[i]["x"]+(j-1)*dx sy[i][j]= y0+pos[i]["y"]+(j-1)*dy Shapes.Move(shp[i][j],sx[i][j] ,sy[i][j]) EndFor EndFor Shapes.Zoom( shp[1][1],0.5,1) EndSub End>QRS755-0.sb< Start>QRS755.sb< ' mahreen miangul Animate Move and Fire MaY 2017 ' Animate Sprite S-W-A-T-F SpaceBar ' Cannon Move and Fire XZ F ' Animate Man ArrowKeys GraphicsWindow.top=0 GraphicsWindow.left=0 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Width = "1288" GraphicsWindow.Height = "666" GraphicsWindow.BackgroundColor="rosybrown" '--------------------Font Animation ----------------------------------------------------------------------------------------- GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 77 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "lightyellow" ' Text shadow color GraphicsWindow.DrawText(285, 5, "mahreen miangul!")' Shadow position/text gold= GraphicsWindow.getcolorfromrgb(121,94,40) GraphicsWindow.BrushColor = gold ' Text color GraphicsWindow.DrawText(280, 0, "mahreen miangul!") ' Position and text GraphicsWindow.KeyDown = onkeyDown x=0 GraphicsWindow.KeyDown=Onkeydown Shapes_Init() Shapes_Add() ' Keys........ S, W, A, T, X,Z,F , SpaceBar and arrow keys work 'Sub OnKeyDown key= GraphicsWindow.LastKey If key="S" Then ddx=4 ElseIf Key="W"then ddx=-4 ElseIf Key="A"then ddy=4 ElseIf key="T"Then ddy=-4 ElseIf key="Space" Then ddx=0 ddy=0 EndIf If shoot="False" Then If Key = "X" Then angle=angle+1 Shapes.Rotate(cannon,angle) ElseIf Key = "Z" Then angle=angle-1 Shapes.Rotate(cannon,angle) ElseIf Key="F" then Shapes.ShowShape(Ball) shoot="True" EndIf endif Sub onkeydown key= GraphicsWindow.LastKey If Text.IsSubText("Right:Left",key) Then ds="X="+KLST[key]+";y=0" If lastkey<>key Then counts=0 Lastangles=initangles EndIf Shapes_Move() ElseIf Text.IsSubText("Up:Down",key) Then ds="X=0;y="+KLST[key] Shapes_Move() EndIf lastkey=Key EndSub Sub Shapes_Move Multi=1.8 counts=counts+1 For i=1 To posnmb x[i]=shapes.GetLeft(shp[i][1]) ' each position -X y[i]=shapes.Gettop(shp[i][1]) ' each position -Y If text.IsSubText(inmbs,":"+i+":") Then x[i]=shapes.GetLeft(shp[i-1][pos[i-1]["NN"]]) ' upper arm/leg last number -X y[i]=shapes.Gettop(shp[i-1][pos[i-1]["NN"]]) ' upper arm/leg last number -Y EndIf MM= Math.Ceiling(2*counts/div) GraphicsWindow.Title=MM+" : "+counts Dangle=PM[MM]*angles[Key][NMB[MM]][i]/div ' dθ/div thisangle=Lastangles[i]+ Multi*Dangle ' current each angle dx=pos[i]["wd"]*math.sin(math.GetRadians(thisangle)) dy=pos[i]["wd"]*math.cos(math.GetRadians(thisangle)) for j=1 To pos[i]["NN"] Shapes.Move(shp[i][j],x[i]+ds["X"]+(j-1)*dx,y[i]+ds["Y"]+(j-1)*dy) ' arms / legs EndFor Lastangles[i]=thisangle EndFor if counts>div*2-1 Then counts=0 EndIf endsub GraphicsWindow.BrushColor = "slateblue" cannon1_x = 333 cannon1_y = 566 cannon = Shapes.AddRectangle(50,100) Shapes.Move(cannon, cannon1_x, cannon1_y) SPRITE_init() ' <--------- all shape data is input here!! add_shapes() ' <--------- all shapes are added here!! dX=0 ' initial Human moving speed-X dY=0 ' initial Human moving speed-Y GraphicsWindow.BrushColor="darkslategray" Ball=Shapes.AddEllipse(40,40) Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) Shapes.HideShape(Ball) Timer.Interval=1000 '<---------- Timer.Tick=duck_up '<---------- 'Animate Cycle dZ = 0.1 zoom = 1 ddx=0 ' initial cycle moving speed-X ddy=0 ' initial cycle moving speed-Y bdx=0 ' initial ball moving speed-X bdy=10 ' initial ball moving speed-Y NMB="5:1" ' Cycle shapes number=5 repeat =1 shoot="False" While 0=0 ' Blinking   zoom = zoom - dZ   For i = 1 To Array.GetItemCount(shape[5]) ' Cycle shapes number=5     If Array.ContainsValue(shape[5][i], "eye") Then       Shapes.Zoom(shp[NMB][i], 1, zoom)     ElseIf Array.ContainsValue(shape[5][i], "mouth") Then       Shapes.Zoom(shp[NMB][i], zoom, zoom)     EndIf shapes.Move(shp[NMB][i],shapes.GetLeft(shp[NMB][i])+ddx,shapes.Gettop(shp[NMB][i])+ddy) EndFor   If zoom = 0.1 Or zoom = 1 Then     dZ = -dZ   EndIf ' cycle reverse moving X,Y direction cycleX= shapes.GetLeft(shp[NMB][3]) ' = face cycleY= shapes.GetTop(shp[NMB][3]) If cycleX<0 Or cycleX>GraphicsWindow.Width-shape[5][3]["width"] Then ddx=-ddx EndIf If cycleY<0 Or cycleY>cannon1_y-shape[5][3]["height"] Then ddy=-ddy EndIf ' ball moving and collision check If shoot Then shapes.Move(Ball ,shapes.GetLeft(ball)+angle/4,shapes.Gettop(ball)-bdy) If shapes.Gettop(ball)<-100 then shoot="False" Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) Shapes.HideShape(Ball) EndIf ' collision check here ballX=shapes.GetLeft(ball) bally=shapes.GetTop(ball) If (cycleXQRS755.sb< Start>QRS854.sb< ' Sierpinski Triangle created using the Chaos Game algorithm (http://en.wikipedia.org/wiki/Sierpinski_triangle) ' By Neil Kendall, August 2011 ' SmallBASIC Challenge of the Week 9 - Advanced Challenge (http://social.msdn.microsoft.com/Forums/en-US/smallbasic/thread/15a4a5bf-98d8-42f9-93ce-7246ef584a2c) ' Triangle vertices created at random, initial start point is also random [possible extension - see below]. Size=400 ' Max sixe of Graphics Window - change this to suit your screen resolution Iterations=30000 ' Change this value for number of pixels plotted. The higher the value the better the picture, but slower to draw. TriangleNumber=1 ' Keep track of number of triangles plotted ' Set up graphics window GraphicsWindow.Height=Size GraphicsWindow.Width=Size GraphicsWindow.BackgroundColor="Blue" GraphicsWindow.BrushColor="White" Loop: ' Start again after each triangle is plotted GraphicsWindow.Clear() TriangleColour=graphicswindow.GetRandomColor() ' Get a random colour to draw the triangle GraphicsWindow.DrawText(5,5,"Random Sierpinski Triangle. Number "+TriangleNumber) ' Display triangle number ' Generate 3 random vertices for the triangle ' Possible extension for you - make sure the random vertices 'look' like a triangle - E.g. Some sets of 3 random vertices are almost in a straight line so the triangle does not look good. Vertex1X=Math.GetRandomNumber(Size) Vertex1Y=Math.GetRandomNumber(Size) Vertex2X=Math.GetRandomNumber(Size) Vertex2Y=Math.GetRandomNumber(Size) Vertex3X=Math.GetRandomNumber(Size) Vertex3Y=Math.GetRandomNumber(Size) ' Set Initial Plot Position (random). If this position is within the area of the random triangle then random pixels outside of the triangle will not be plotted. [Very good extension exercise for you!] CurrentPosX=Math.GetRandomNumber(Size) CurrentPosY=Math.GetRandomNumber(Size) For count=0 To Iterations RandomVertex=math.GetRandomNumber(3) ' Choose a random vertex If RandomVertex=1 Then NewPositionX=(CurrentPosX+Vertex1X)/2 ' Calculate the X-coord of the midpoint between the current position and Vertex1 NewPositionY=(CurrentPosY+Vertex1Y)/2 ' Calculate the Y-coord of the midpoint between the current position and Vertex1 GraphicsWindow.SetPixel(NewPositionX,NewPositionY,TriangleColour) CurrentPosX=NewPositionX ' Make the current position the new calculated position CurrentPosY=NewPositionY EndIf If RandomVertex=2 Then NewPositionX=(CurrentPosX+Vertex2X)/2 ' Calculate the X-coord of the midpoint between the current position and Vertex2 NewPositionY=(CurrentPosY+Vertex2Y)/2 ' Calculate the Y-coord of the midpoint between the current position and Vertex2 GraphicsWindow.SetPixel(NewPositionX,NewPositionY,TriangleColour) CurrentPosX=NewPositionX ' Make the current position the new calculated position CurrentPosY=NewPositionY EndIf If RandomVertex=3 Then NewPositionX=(CurrentPosX+Vertex3X)/2 ' Calculate the X-coord of the midpoint between the current position and Vertex3 NewPositionY=(CurrentPosY+Vertex3Y)/2 ' Calculate the Y-coord of the midpoint between the current position and Vertex3 GraphicsWindow.SetPixel(NewPositionX,NewPositionY,TriangleColour) CurrentPosX=NewPositionX ' Make the current position the new calculated position CurrentPosY=NewPositionY EndIf EndFor TriangleNumber=TriangleNumber+1 Goto Loop End>QRS854.sb< Start>QRT907-0.sb< 'add an inputField Object[1]["type"]="Field" Object[1]["left"]=150 Object[1]["top"]=10 Object[1]["width"]=100 Object[1]["height"]=20 Object[1]["text"]="" 'add another inputField Object[2]["type"]="Field" Object[2]["left"]=150 Object[2]["top"]=40 Object[2]["width"]=100 Object[2]["height"]=20 Object[2]["text"]="" 'add a Button Object[3]["type"]="Button" Object[3]["left"]=10 Object[3]["top"]=70 Object[3]["width"]=50 Object[3]["height"]=20 Object[3]["text"]="Close" 'add a Label Object[4]["type"]="Label" Object[4]["left"]=10 Object[4]["top"]=10 Object[4]["width"]=120 Object[4]["height"]=20 Object[4]["text"]="Enter text here:" 'add another Label Object[5]["type"]="Label" Object[5]["left"]=10 Object[5]["top"]=40 Object[5]["width"]=120 Object[5]["height"]=20 Object[5]["text"]="mouse position:" 'add another inputField count=5 For x=0 to 4 For y=0 To 4 count=count+1 Object[count]["type"]="Field" Object[count]["left"]=20+x*100 Object[count]["top"]=100+y*20 Object[count]["width"]=100 Object[count]["height"]=19 Object[count]["text"]=x+","+y EndFor endfor 'Clear table button Object[31]["type"]="Button" Object[31]["left"]=100 Object[31]["top"]=70 Object[31]["width"]=100 Object[31]["height"]=20 Object[31]["text"]="Clear Table" OverObject=0 CurrentObject=3 drawObjects() GraphicsWindow.MouseMove=OnHandleMouseMove MouseMoveEvent = 0 Sub OnHandleMouseMove MouseMoveEvent = 1 EndSub GraphicsWindow.MouseDown=OnhandleMouseDown MouseDownEvent = 0 Sub OnhandleMouseDown If (MouseDownEvent = 0) Then MouseDownEvent = 1 EndIf EndSub GraphicsWindow.MouseUp=OnhandleMouseUp Sub OnhandleMouseUp MouseDownEvent = 0 EndSub GraphicsWindow.KeyDown=OnhandleKeyDown KeyDownEvent = 0 Sub OnhandleKeyDown KeyDownEvent = 1 EndSub While ("True") If (MouseMoveEvent = 1) Then HandleMouseMove() MouseMoveEvent = 0 EndIf If (MouseDownEvent = 1) Then handleMouseDown() MouseDownEvent = 2 ' Wait for mouse up before looking for next mouse down EndIf If (KeyDownEvent = 1) Then handleKeyDown() KeyDownEvent = 0 EndIf Program.Delay(100) EndWhile sub drawObjects ClearObjects() For i=1 To Array.GetItemCount(Object) GraphicsWindow.PenWidth=1 If Object[i]["type"]="Field" then If i=overObject then GraphicsWindow.penWidth=3 Else GraphicsWindow.PenWidth=1 endif GraphicsWindow.BrushColor="White" GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Button" then 'experimetn with mouseOver colourchange if i=currentObject then GraphicsWindow.BrushColor="Yellow" else GraphicsWindow.BrushColor="White" endif GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Label" then GraphicsWindow.BrushColor="White" GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) endif EndFor endsub Sub HandleMouseMove OverObject=0 For i=1 To Array.GetItemCount(Object) If (Object[i]["left"]<=GraphicsWindow.MouseX) and (Object[i]["left"]+Object[i]["width"]>=GraphicsWindow.MouseX) and (Object[i]["top"]<=GraphicsWindow.MouseY) and (Object[i]["top"]+Object[i]["height"]>=GraphicsWindow.MouseY) then OverObject=i endif EndFor 'Object[1]["text"]=OverObject+","+CurrentObject Object[2]["text"]=GraphicsWindow.MouseX+"," +GraphicsWindow.mouseY 'if overObject<>0 then drawObjects() 'endif EndSub Sub handleKeyDown If Object[CurrentObject]["type"]="Button" then key=graphicsWindow.lastKey If key="Return" then ButtonPressed() endif ElseIf Object[CurrentObject]["type"]="Field" then key=GraphicsWindow.Lastkey 'DEBUG: GraphicsWindow.DrawBoundText(20,100,200,key) If key="Back" then s=Object[currentObject]["text"] Object[currentObject]["text"]=Text.GetSubText(s,1,text.getlength(s)-1) elseif (Text.GetLength(key)<2) then 'lousy way to determine if it was a letter s=Object[currentObject]["text"] Object[currentObject]["text"]=s+key elseif (Text.StartsWith(key,"D") and (Text.GetLength(key)=2)) then 'it's a digit s=Object[currentObject]["text"] Object[currentObject]["text"]=s+text.GetSubText(key,2,1) else GraphicsWindow.ShowMessage(key+" pressed, only letters and digits can currently be processed","Oeps") endif endif drawObjects() endsub Sub HandleMouseDown If OverObject<>0 Then CurrentObject=OverObject EndIf drawObjects() If CurrentObject=1 Then ElseIf CurrentObject=2 Then ElseIf (CurrentObject=3) or (CurrentObject=31)Then Sound.PlayClick() ButtonPressed() Endif EndSub Sub ClearObjects GraphicsWindow.Clear() endsub Sub ButtonPressed 'this code is executed when the button is pressed with the mouse If CurrentObject=3 then Program.End() ElseIf CurrentObject=31 then For u=6 to 30 object[u]["text"]="" endfor endif endsub End>QRT907-0.sb< Start>QRT907-3.sb< 'add an inputField Object[1]["type"]="Field" Object[1]["left"]=150 Object[1]["top"]=10 Object[1]["width"]=100 Object[1]["height"]=20 Object[1]["text"]="" 'add another inputField Object[2]["type"]="Field" Object[2]["left"]=150 Object[2]["top"]=40 Object[2]["width"]=100 Object[2]["height"]=20 Object[2]["text"]="" 'add a Button Object[3]["type"]="Button" Object[3]["left"]=10 Object[3]["top"]=70 Object[3]["width"]=50 Object[3]["height"]=20 Object[3]["text"]="Close" 'add a Label Object[4]["type"]="Label" Object[4]["left"]=10 Object[4]["top"]=10 Object[4]["width"]=120 Object[4]["height"]=20 Object[4]["text"]="Enter text here:" 'add another Label Object[5]["type"]="Label" Object[5]["left"]=10 Object[5]["top"]=40 Object[5]["width"]=120 Object[5]["height"]=20 Object[5]["text"]="mouse position:" 'add another inputField count=5 For x=0 to 4 For y=0 To 4 count=count+1 Object[count]["type"]="Field" Object[count]["left"]=20+x*100 Object[count]["top"]=100+y*20 Object[count]["width"]=100 Object[count]["height"]=19 Object[count]["text"]=x+","+y EndFor endfor 'Clear table button Object[31]["type"]="Button" Object[31]["left"]=100 Object[31]["top"]=70 Object[31]["width"]=100 Object[31]["height"]=20 Object[31]["text"]="Clear Table" OverObject=0 CurrentObject=3 drawObjects() GraphicsWindow.MouseMove=OnHandleMouseMove MouseMoveEvent = 0 Sub OnHandleMouseMove MouseMoveEvent = 1 EndSub GraphicsWindow.MouseDown=OnhandleMouseDown MouseDownEvent = 0 Sub OnhandleMouseDown If (MouseDownEvent = 0) Then MouseDownEvent = 1 EndIf EndSub GraphicsWindow.MouseUp=OnhandleMouseUp Sub OnhandleMouseUp MouseDownEvent = 0 EndSub GraphicsWindow.KeyDown=OnhandleKeyDown KeyDownEvent = 0 Sub OnhandleKeyDown KeyDownEvent = 1 EndSub While ("True") If (MouseMoveEvent = 1) Then HandleMouseMove() MouseMoveEvent = 0 EndIf If (MouseDownEvent = 1) Then handleMouseDown() MouseDownEvent = 2 ' Wait for mouse up before looking for next mouse down EndIf If (KeyDownEvent = 1) Then handleKeyDown() KeyDownEvent = 0 EndIf Program.Delay(100) EndWhile sub drawObjects ClearObjects() For i=1 To Array.GetItemCount(Object) GraphicsWindow.PenWidth=1 If Object[i]["type"]="Field" then If i=overObject then GraphicsWindow.penWidth=3 Else GraphicsWindow.PenWidth=1 endif GraphicsWindow.BrushColor="White" GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Button" then 'experimetn with mouseOver colourchange if i=currentObject then GraphicsWindow.BrushColor="Yellow" else GraphicsWindow.BrushColor="White" endif GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Label" then GraphicsWindow.BrushColor="White" GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) endif EndFor endsub Sub HandleMouseMove OverObject=0 For i=1 To Array.GetItemCount(Object) If (Object[i]["left"]<=GraphicsWindow.MouseX) and (Object[i]["left"]+Object[i]["width"]>=GraphicsWindow.MouseX) and (Object[i]["top"]<=GraphicsWindow.MouseY) and (Object[i]["top"]+Object[i]["height"]>=GraphicsWindow.MouseY) then OverObject=i endif EndFor 'Object[1]["text"]=OverObject+","+CurrentObject Object[2]["text"]=GraphicsWindow.MouseX+"," +GraphicsWindow.mouseY 'if overObject<>0 then drawObjects() 'endif EndSub Sub handleKeyDown If Object[CurrentObject]["type"]="Button" then key=graphicsWindow.lastKey If key="Return" then ButtonPressed() endif ElseIf Object[CurrentObject]["type"]="Field" then key=GraphicsWindow.Lastkey 'DEBUG: GraphicsWindow.DrawBoundText(20,100,200,key) If key="Back" then s=Object[currentObject]["text"] Object[currentObject]["text"]=Text.GetSubText(s,1,text.getlength(s)-1) elseif (Text.GetLength(key)<2) then 'lousy way to determine if it was a letter s=Object[currentObject]["text"] Object[currentObject]["text"]=s+key elseif (Text.StartsWith(key,"D") and (Text.GetLength(key)=2)) then 'it's a digit s=Object[currentObject]["text"] Object[currentObject]["text"]=s+text.GetSubText(key,2,1) else GraphicsWindow.ShowMessage(key+" pressed, only letters and digits can currently be processed","Oeps") endif endif drawObjects() endsub Sub HandleMouseDown If OverObject<>0 Then CurrentObject=OverObject EndIf drawObjects() If CurrentObject=1 Then ElseIf CurrentObject=2 Then ElseIf (CurrentObject=3) or (CurrentObject=31)Then Sound.PlayClick() ButtonPressed() Endif EndSub Sub ClearObjects GraphicsWindow.Clear() endsub Sub ButtonPressed 'this code is executed when the button is pressed with the mouse If CurrentObject=3 then Program.End() ElseIf CurrentObject=31 then For u=6 to 30 object[u]["text"]="" endfor endif endsub End>QRT907-3.sb< Start>QRT907.sb< 'add an inputField Object[1]["type"]="Field" Object[1]["left"]=150 Object[1]["top"]=10 Object[1]["width"]=100 Object[1]["height"]=20 Object[1]["text"]="" 'add another inputField Object[2]["type"]="Field" Object[2]["left"]=150 Object[2]["top"]=40 Object[2]["width"]=100 Object[2]["height"]=20 Object[2]["text"]="" 'add a Button Object[3]["type"]="Button" Object[3]["left"]=10 Object[3]["top"]=70 Object[3]["width"]=50 Object[3]["height"]=20 Object[3]["text"]="Close" 'add a Label Object[4]["type"]="Label" Object[4]["left"]=10 Object[4]["top"]=10 Object[4]["width"]=120 Object[4]["height"]=20 Object[4]["text"]="Enter text here:" 'add another Label Object[5]["type"]="Label" Object[5]["left"]=10 Object[5]["top"]=40 Object[5]["width"]=120 Object[5]["height"]=20 Object[5]["text"]="mouse position:" 'add another inputField count=5 For x=0 to 4 For y=0 To 4 count=count+1 Object[count]["type"]="Field" Object[count]["left"]=20+x*100 Object[count]["top"]=100+y*20 Object[count]["width"]=100 Object[count]["height"]=19 Object[count]["text"]=x+","+y EndFor endfor 'Clear table button Object[31]["type"]="Button" Object[31]["left"]=100 Object[31]["top"]=70 Object[31]["width"]=100 Object[31]["height"]=20 Object[31]["text"]="Clear Table" OverObject=0 CurrentObject=3 drawObjects() GraphicsWindow.MouseMove=HandleMouseMove GraphicsWindow.MouseDown=handleMouseDown GraphicsWindow.KeyDown=handleKeyDown sub drawObjects ClearObjects() For i=1 To Array.GetItemCount(Object) GraphicsWindow.PenWidth=1 If Object[i]["type"]="Field" then If i=overObject then GraphicsWindow.penWidth=3 Else GraphicsWindow.PenWidth=1 endif GraphicsWindow.BrushColor="White" GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Button" then 'experimetn with mouseOver colourchange if i=currentObject then GraphicsWindow.BrushColor="Yellow" else GraphicsWindow.BrushColor="White" endif GraphicsWindow.DrawRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.FillRectangle(Object[i]["left"],Object[i]["top"],Object[i]["width"],Object[i]["height"]) GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) elseif Object[i]["type"]="Label" then GraphicsWindow.BrushColor="White" GraphicsWindow.BrushColor="Blue" GraphicsWindow.DrawBoundText(Object[i]["left"]+2,Object[i]["top"]+2,object[i]["width"],Object[i]["text"]) endif EndFor endsub Sub HandleMouseMove OverObject=0 For i=1 To Array.GetItemCount(Object) If (Object[i]["left"]<=GraphicsWindow.MouseX) and (Object[i]["left"]+Object[i]["width"]>=GraphicsWindow.MouseX) and (Object[i]["top"]<=GraphicsWindow.MouseY) and (Object[i]["top"]+Object[i]["height"]>=GraphicsWindow.MouseY) then OverObject=i endif EndFor 'Object[1]["text"]=OverObject+","+CurrentObject Object[2]["text"]=GraphicsWindow.MouseX+"," +GraphicsWindow.mouseY 'if overObject<>0 then drawObjects() 'endif EndSub Sub handleKeyDown If Object[CurrentObject]["type"]="Button" then key=graphicsWindow.lastKey If key="Return" then ButtonPressed() endif ElseIf Object[CurrentObject]["type"]="Field" then key=GraphicsWindow.Lastkey 'DEBUG: GraphicsWindow.DrawBoundText(20,100,200,key) If key="Back" then s=Object[currentObject]["text"] Object[currentObject]["text"]=Text.GetSubText(s,1,text.getlength(s)-1) elseif (Text.GetLength(key)<2) then 'lousy way to determine if it was a letter s=Object[currentObject]["text"] Object[currentObject]["text"]=s+key elseif (Text.StartsWith(key,"D") and (Text.GetLength(key)=2)) then 'it's a digit s=Object[currentObject]["text"] Object[currentObject]["text"]=s+text.GetSubText(key,2,1) else GraphicsWindow.ShowMessage(key+" pressed, only letters and digits can currently be processed","Oeps") endif endif drawObjects() endsub Sub HandleMouseDown If OverObject<>0 Then CurrentObject=OverObject EndIf drawObjects() If CurrentObject=1 Then ElseIf CurrentObject=2 Then ElseIf (CurrentObject=3) or (CurrentObject=31)Then Sound.PlayClick() ButtonPressed() Endif EndSub Sub ClearObjects GraphicsWindow.Clear() endsub Sub ButtonPressed 'this code is executed when the button is pressed with the mouse If CurrentObject=3 then Program.End() ElseIf CurrentObject=31 then For u=6 to 30 object[u]["text"]="" endfor endif endsub End>QRT907.sb< Start>QRV716.sb< ' SmallBasic Version 1.2 ' Program: Gradient Slider ' Changelog: 16.1 ' Author: Pappa Lapub, Koopakilla (Tom Lambert) ' Website: https://social.msdn.microsoft.com/Forums/en-US/ca8db35c-abc7-4a9f-9e92-a1e4ae7c4ea4/colors-shapes-and-brushes ' https://code.msdn.microsoft.com/Slider-mit-Farbverlauf-im-04ec91b4 ' ImportURL: http://smallbasic.com/program/? ' Extension: LitDev ' Comment: https://code.msdn.microsoft.com/Slider-mit-Farbverlauf-im-04ec91b4 ' https://social.msdn.microsoft.com/profile/tom%20lambert%20(koopakiller)/ ' http://code-13.net/ ' http://dotnet-snippets.de/user/koopakiller/1829 de. ' http://dotnet-snippets.com/user/koopakiller/6677 engl. ' Variables: Selection of 100*100*100 = 1E6 colors ' KEYS: Esc .. Exit; Space .. Reset to init. Values ' R-Mouse click in color square copies #RRGGBB to clipbrd; R-Mouse + R key as R,G,B ' ================================================================================ arrInitVal = "1=128;2=128;3=128;" ' 0 - 255 'arrInitVal = "1=0;2=0;3=1;" ' needs (below) ShowNoShapeErrors = "", if value < 2 arrSlidVal = arrInitVal title = "GradientSlider [" GraphicsWindow.Hide() GraphicsWindow.CanResize = "" GraphicsWindow.Width = 370 GraphicsWindow.Height = 120 GraphicsWindow.BackgroundColor = "#101010" 'LDGraphicsWindow.Icon = ..... GraphicsWindow.PenWidth = 0 shpCol = Shapes.AddRectangle(100,100) Shapes.Move(shpCol, 10,10) LDUtilities.ShowNoShapeErrors = "" '' for value < 2 in arrSlidVal For n = 1 To 3 arrSlider[n] = LDControls.AddSlider(200,22, "H") Shapes.Move(arrSlider[n], 160, 19 + (n-1) * 30) 'LDControls.SliderValue(arrSlider[n], arrSlidVal[n] / 2.55) EndFor Reset() GraphicsWindow.FontBold = "" GraphicsWindow.BrushColor = "Red" GraphicsWindow.DrawText(120, 24, "#RR:") ' "Rot:") GraphicsWindow.BrushColor = "Lime" GraphicsWindow.DrawText(120, 53, "#GG:") ' "Grün:") GraphicsWindow.BrushColor = "Blue" GraphicsWindow.DrawText(120, 82, "#BB:") ' "Blau:") bInitBrush = "True" OnSliderChange() ' set init. Brushes, lastSlider is/was Control3 (from .AddSlider) bInitBrush = "" GraphicsWindow.Show() GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp GraphicsWindow.MouseDown = OnMouseDown LDControls.SliderChanged = OnSliderChange ' ////////// EVENTs \\\\\\\\\\ Sub OnKeyDown lastKey = GraphicsWindow.LastKey If lastKey = "Escape" Then Program.End() ElseIf lastKey = "Space" Then Reset() EndIf EndSub Sub OnKeyUp lastKey = "" EndSub Sub OnMouseDown If Mouse.IsRightButtonDown Then mx = GraphicsWindow.MouseX my = GraphicsWindow.MouseY 'If mx > 9 And mx < 111 And my > 9 And my < 111 Then ' Pos./Incl. If mx < 10 Or mx > 110 Or my < 10 Or my > 110 Then ' Neg./Excl. Else If lastKey = "R" Then LDClipboard.SetText(arrSlidVal[1] +","+ arrSlidVal[2] +","+ arrSlidVal[3]) ' "R,G,B: "+ Else LDClipboard.SetText(col) ' "#RRGGBB:"+ col EndIf LDShapes.AnimateOpacity(shpCol, 200, 5) EndIf EndIf EndSub Sub OnSliderChange '' 0 - 100 %, 0 - 255 lastSlider = LDControls.LastSlider '' Control# lastNo = Text.GetSubTextToEnd(lastSlider, Text.GetLength(lastSlider)) '' # from Control# arrSlidVal[lastNo] = Math.Round(2.55 * LDControls.SliderGetValue(arrSlider[lastNo])) col = GraphicsWindow.GetColorFromRGB(arrSlidVal[1], arrSlidVal[2], arrSlidVal[3]) LDShapes.BrushColour(shpCol, col) If lastSlider <> arrSlider[1] Then '' don't process current slider1 arrCols[1] = GraphicsWindow.GetColorFromRGB(0, arrSlidVal[2], arrSlidVal[3]) arrCols[2] = GraphicsWindow.GetColorFromRGB(255, arrSlidVal[2], arrSlidVal[3]) LDShapes.BrushShape(arrSlider[1], LDShapes.BrushGradient(arrCols, "H")) EndIf If lastSlider <> arrSlider[2] Then '' don't process current slider2 arrCols[1] = GraphicsWindow.GetColorFromRGB(arrSlidVal[1], 0, arrSlidVal[3]) arrCols[2] = GraphicsWindow.GetColorFromRGB(arrSlidVal[1], 255, arrSlidVal[3]) LDShapes.BrushShape(arrSlider[2], LDShapes.BrushGradient(arrCols, "H")) EndIf If lastSlider <> arrSlider[3] Or bInitBrush Then '' also process Control3 on first call arrCols[1] = GraphicsWindow.GetColorFromRGB(arrSlidVal[1], arrSlidVal[2], 0) arrCols[2] = GraphicsWindow.GetColorFromRGB(arrSlidVal[1], arrSlidVal[2], 255) LDShapes.BrushShape(arrSlider[3], LDShapes.BrushGradient(arrCols, "H")) EndIf GraphicsWindow.Title = title + col + "]" EndSub ' ////////// SUB \\\\\\\\\\ Sub Reset For n = 1 To 3 LDControls.SliderValue(arrSlider[n], Math.Round(arrInitVal[n] / 2.55)) '' AUTO calls OnSliderChange event EndFor EndSub End>QRV716.sb< Start>QRW232-0.sb< ' Avatar Genarator ' Version 0.2 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' Program ID QRW232-0 GraphicsWindow.Title = "Aavatar Generator 0.2" debug = "False" Init() If debug Then UnitTest() EndIf nShape = Array.GetItemCount(shape) While "True" GraphicsWindow.Clear() col = 4 row = 3 x0 = (gw - (3 * size) * col - 10 * (col - 1)) / 2 y0 = (gh - (3 * size) * row - 10 * (row - 1)) / 2 For j = 1 To col * row s2 = nShape + 1 DecidePattern() If debug Then TextWindow.WriteLine("Decided:pattern=" + pattern) EndIf color = GraphicsWindow.GetRandomColor() For i = 1 To 6 p = rotate[i]["p"] p2 = rotate[i]["p2"] angle = rotate[i]["angle"] RotatePattern() EndFor If debug Then For p = 1 To Array.GetItemCount(pattern) TextWindow.WriteLine("pattern[" + p + "]=" + pattern[p]) EndFor For s = 1 To Array.GetItemCount(shape) TextWindow.WriteLine("shape[" + s + "]=" + shape[s]) EndFor EndIf p = 1 For y = y0 To y0 + 2 * size Step size For x = x0 To x0 + 2 * size Step size DrawPattern() p = p + 1 EndFor EndFor If Math.Remainder((j - 1), col) = col - 1 Then x0 = (gw - (3 * size) * col - 10 * (col - 1)) / 2 y0 = y0 + (3 * size + 10) Else x0 = x0 + (3 * size + 10) EndIf EndFor Program.Delay(5000) EndWhile Sub Init ' graphics window size size = 40 gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh ' rotate center position cx = 0.5 cy = 0.5 ' base patterns candidate[1] = "1=5;2=3;" candidate[2] = "1=5;2=10;" candidate[3] = "1=1;2=3;" candidate[4] = "1=6;2=10;" candidate[5] = "1=1;2=8;" candidate[6] = "1=12;2=13;" candidate[7] = "1=6;2=14;" candidate[8] = "1=8;2=7;" candidate[9] = "1=13;2=14;" candidate[10] = "1=14;2=15;" candidate[11] = "1=1;2=11;" candidate[12] = "1=6;2=8;" candidate[13] = "1=2;2=6;" candidate[14] = "1=3;2=14;" candidate[15] = "1=6;2=3;" ' parts (shapes) shape[1] = "type=rect;x=0;y=0;width=0.5;height=0.5;" shape[2] = "type=rect;x=0.5;y=0;width=0.5;height=0.5;" shape[3] = "type=rect;x=0.5;y=0.5;width=0.5;height=0.5;" shape[4] = "type=rect;x=0;y=0.5;width=0.5;height=0.5;" shape[5] = "type=tri;x1=0;y1=0;x2=0;y2=1;x3=1;y3=0;" shape[6] = "type=tri;x1=0;y1=0;x2=0;y2=1;x3=0.5;y3=1;" shape[7] = "type=tri;x1=0;y1=0;x2=0.5;y2=0;x3=0.5;y3=1;" shape[8] = "type=tri;x1=0.5;y1=0;x2=0.5;y2=1;x3=1;y3=1;" shape[9] = "type=tri;x1=0.5;y1=0;x2=1;y2=0;x3=1;y3=1;" shape[10] = "type=tri;x1=1;y1=0;x2=0.5;y2=1;x3=1;y3=1;" shape[11] = "type=tri;x1=1;y1=0;x2=0.5;y2=1;x3=0.5;y3=0;" shape[12] = "type=tri;x1=0;y1=0;x2=0.5;y2=0;x3=0;y3=1;" shape[13] = "type=tri;x1=1;y1=0.5;x2=0;y2=1;x3=1;y3=1;" shape[14] = "type=tri;x1=0;y1=0;x2=1;y2=0;x3=0.5;y3=0.5;" shape[15] = "type=tri;x1=0.5;y1=0.5;x2=0;y2=1;x3=1;y3=1;" ' rotated patterns rotate[1] = "p=1;p2=3;angle=90;" rotate[2] = "p=2;p2=6;angle=90;" rotate[3] = "p=1;p2=9;angle=180;" rotate[4] = "p=2;p2=8;angle=180;" rotate[5] = "p=1;p2=7;angle=270;" rotate[6] = "p=2;p2=4;angle=270;" EndSub Sub DecidePattern ' return pattern - pattern array [1, 2, 5] ' decide base patterns pattern = "" n = Array.GetItemCount(candidate) indices = Array.GetAllIndices(candidate) For _p = 1 To 3 n = Array.GetItemCount(indices) index = Array.GetAllIndices(indices) i = Math.GetRandomNumber(n) If _p = 3 Then _p = 5 EndIf pattern[_p] = candidate[index[i]] pattern[_p + 1] = candidate[index[i]] a = Math.GetRandomNumber(4) - 1 If 0 < a Then p = _p + 1 p2 = _p angle = a * 90 RotatePattern() EndIf indices[index[i]] = "" EndFor EndSub Sub DrawPattern ' param pattern - pattern array ' param p - patten index ' param color - fill color If debug Then TextWindow.WriteLine("DrawPattern:") TextWindow.WriteLine("p=" + p) TextWindow.WriteLine("pattern[p]=" + pattern[p]) If pattern[p] = "" Then TextWindow.Read() EndIf EndIf GraphicsWindow.BrushColor = color n = Array.GetItemCount(pattern[p]) If debug Then TextWindow.WriteLine("n=" + n) EndIf For s = 1 To n shp = shape[pattern[p][s]] If shp["type"] = "rect" Then _x = x + shp["x"] * size _y = y + shp["y"] * size _width = shp["width"] * size _height = shp["height"] * size GraphicsWindow.FillRectangle(_x, _y, _width, _height) ElseIf shp["type"] = "tri" Then _x1 = x + shp["x1"] * size _y1 = y + shp["y1"] * size _x2 = x + shp["x2"] * size _y2 = y + shp["y2"] * size _x3 = x + shp["x3"] * size _y3 = y + shp["y3"] * size If debug Then TextWindow.Write("FillTriangle(" + _x1 + "," + _y1 + ",") TextWindow.Write(_x2 + "," + _y2 + ",") TextWindow.WriteLine(_x3 + "," + _y3 + ")") EndIf GraphicsWindow.FillTriangle(_x1, _y1, _x2, _y2, _x3, _y3) EndIf EndFor EndSub Sub RotatePattern ' param p - patten index ' param p2 - rotated pattern index ' param angle - rotate angle n = Array.GetItemCount(pattern[p]) For s = 1 To n shp = shape[pattern[p][s]] shp2 = "type=" + shp["type"] + ";" If shp["type"] = "rect" Then If angle = 90 Then If debug Then TextWindow.WriteLine("angle=90") EndIf q = pattern[p][s] + 1 If 4 < q Then q = q - 4 EndIf ElseIf angle = 180 Then q = pattern[p][s] + 2 If 4 < q Then q = q - 4 EndIf ElseIf angle = 270 Then q = pattern[p][s] + 3 If 4 < q Then q = q - 4 EndIf EndIf pattern[p2][s] = q ElseIf shp["type"] = "tri" Then If debug Then TextWindow.WriteLine("shp=" + shp) EndIf x = shp["x1"] y = shp["y1"] RotatePoint() shp2["x1"] = x shp2["y1"] = y x = shp["x2"] y = shp["y2"] RotatePoint() shp2["x2"] = x shp2["y2"] = y x = shp["x3"] y = shp["y3"] RotatePoint() shp2["x3"] = x shp2["y3"] = y If debug Then TextWindow.WriteLine("shp2=" + shp2) EndIf shape[s2] = shp2 pattern[p2][s] = s2 s2 = s2 + 1 EndIf EndFor EndSub Sub RotatePoint ' param x, y - point to rotate ' param angle - rotate angle ' param cx, cy - rotate center ' return x, y - rotated point lx = x - cx ly = y - cy _a = Math.GetRadians(angle) x = Math.Round((Math.Cos(_a) * lx - Math.Sin(_a) * ly) * 100) / 100 y = Math.Round((Math.Sin(_a) * lx + Math.Cos(_a) * ly) * 100) / 100 x = x + cx y = y + cy EndSub Sub UnitTest y = 10 x = 10 nCandidate = Array.GetItemCount(candidate) For p = 1 To nCandidate pattern[p] = candidate[p] color = "Black" DrawPattern() GraphicsWindow.DrawText(x, y + size, p) x = x + (size + 10) If gw < x + 100 Then x = 10 y = y + (size + 20) EndIf EndFor TextWindow.Read() nShape = Array.GetItemCount(shape) y = 10 pattern = "" GraphicsWindow.PenColor = "Gray" For p = 1 To nShape s2 = nShape + 1 x = 10 GraphicsWindow.Clear() pattern[p] = "1=" + p + ";" color = "Black" GraphicsWindow.DrawRectangle(x, y, size, size) DrawPattern() color = "Green" p2 = p For a = 1 To 3 x = x + (size + 10) angle = a * 90 p2 = p2 + 1 Stack.PushValue("local", x) Stack.PushValue("local", y) RotatePattern() y = Stack.PopValue("local") x = Stack.PopValue("local") GraphicsWindow.DrawRectangle(x, y, size, size) Stack.PushValue("local", p) p = p2 DrawPattern() p = Stack.PopValue("local") EndFor TextWindow.Write("p=" + p) TextWindow.Read() EndFor EndSub End>QRW232-0.sb< Start>QRW232.sb< ' Avatar Genarator ' Version 0.1 ' Copyright © 2016 Nonki Takahashi. The MIT License. GraphicsWindow.Title = "Aavatar" debug = "False" size = 100 gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh candidate[1] = "1=5;2=3;" candidate[2] = "1=5;2=10;" candidate[3] = "1=1;2=3;" candidate[4] = "1=6;2=10;" candidate[5] = "1=1;2=8;" shape[1] = "type=rect;x=0;y=0;width=0.5;height=0.5;" shape[2] = "type=rect;x=0.5;y=0;width=0.5;height=0.5;" shape[3] = "type=rect;x=0.5;y=0.5;width=0.5;height=0.5;" shape[4] = "type=rect;x=0;y=0.5;width=0.5;height=0.5;" shape[5] = "type=tri;x1=0;y1=0;x2=0;y2=1;x3=1;y3=0;" shape[6] = "type=tri;x1=0;y1=0;x2=0;y2=1;x3=0.5;y3=1;" shape[7] = "type=tri;x1=0;y1=0;x2=0.5;y2=0;x3=0.5;y3=1;" shape[8] = "type=tri;x1=0.5;y1=0;x2=0.5;y2=1;x3=1;y3=1;" shape[9] = "type=tri;x1=0.5;y1=0;x2=1;y2=0;x3=1;y3=1;" shape[10] = "type=tri;x1=1;y1=0;x2=0.5;y2=1;x3=1;y3=1;" shape[11] = "type=tri;x1=0.5;y1=1;x2=1;y2=0;x3=1;y3=1;" shape[12] = "type=tri;x1=0.5;y1=1;x2=1;y2=0;x3=1;y3=1;" shape[13] = "type=tri;x1=0;y1=0;x2=1;y2=0;x3=0.5;y3=0.5;" shape[14] = "type=tri;x1=0.5;y1=0.5;x2=0;y2=1;x3=1;y3=1;" rotate[1] = "p=1;p2=3;angle=90;" rotate[2] = "p=2;p2=6;angle=90;" rotate[3] = "p=1;p2=9;angle=180;" rotate[4] = "p=2;p2=8;angle=180;" rotate[5] = "p=1;p2=7;angle=270;" rotate[6] = "p=2;p2=4;angle=270;" While "True" GraphicsWindow.Clear() DecidePattern() color = GraphicsWindow.GetRandomColor() x0 = (gw - 3 * size) / 2 y0 = (gh - 3 * size) / 2 cx = 0.5 cy = 0.5 s2 = Array.GetItemCount(shape) + 1 For i = 1 To 6 p = rotate[i]["p"] p2 = rotate[i]["p2"] angle = rotate[i]["angle"] RotatePattern() EndFor If debug Then For p = 1 To Array.GetItemCount(pattern) TextWindow.WriteLine("pattern[" + p + "]=" + pattern[p]) EndFor For s = 1 To Array.GetItemCount(shape) TextWindow.WriteLine("shape[" + s + "]=" + shape[s]) EndFor EndIf p = 1 For y = y0 To y0 + 2 * size Step size For x = x0 To x0 + 2 * size Step size DrawPattern() p = p + 1 EndFor EndFor Program.Delay(3000) EndWhile Sub DecidePattern n = Array.GetItemCount(candidate) For i = 1 To n indices[i] = i EndFor For p = 1 To 3 n = Array.GetItemCount(indices) index = Array.GetAllIndices(indices) i = Math.GetRandomNumber(n) If p = 3 Then p = 5 EndIf pattern[p] = candidate[index[i]] indices[index[i]] = "" EndFor EndSub Sub DrawPattern ' param p - patten number ' param color - fill color GraphicsWindow.BrushColor = color n = Array.GetItemCount(pattern[p]) For s = 1 To n shp = shape[pattern[p][s]] If shp["type"] = "rect" Then _x = x + shp["x"] * size _y = y + shp["y"] * size _width = shp["width"] * size _height = shp["height"] * size GraphicsWindow.FillRectangle(_x, _y, _width, _height) ElseIf shp["type"] = "tri" Then _x1 = x + shp["x1"] * size _y1 = y + shp["y1"] * size _x2 = x + shp["x2"] * size _y2 = y + shp["y2"] * size _x3 = x + shp["x3"] * size _y3 = y + shp["y3"] * size GraphicsWindow.FillTriangle(_x1, _y1, _x2, _y2, _x3, _y3) EndIf EndFor EndSub Sub RotatePattern ' param p - patten number ' param p2 - rotated pattern ' param angle - rotate angle n = Array.GetItemCount(pattern[p]) For s = 1 To n shp = shape[pattern[p][s]] shp2 = "type=" + shp["type"] + ";" If shp["type"] = "rect" Then If angle = 90 Then x = shp["x"] y = shp["y"] + shp["height"] RotatePoint() shp2["x"] = x shp2["y"] = y shp2["width"] = shp["height"] shp2["height"] = shp["width"] ElseIf angle = 180 Then x = shp["x"] + shp["width"] y = shp["y"] + shp["height"] RotatePoint() shp2["x"] = x shp2["y"] = y shp2["width"] = shp["width"] shp2["height"] = shp["height"] ElseIf angle = 270 Then x = shp["x"] + shp["width"] y = shp["y"] RotatePoint() shp2["x"] = x shp2["y"] = y shp2["width"] = shp["height"] shp2["height"] = shp["width"] EndIf ElseIf shp["type"] = "tri" Then x = shp["x1"] y = shp["y1"] RotatePoint() shp2["x1"] = x shp2["y1"] = y x = shp["x2"] y = shp["y2"] RotatePoint() shp2["x2"] = x shp2["y2"] = y x = shp["x3"] y = shp["y3"] RotatePoint() shp2["x3"] = x shp2["y3"] = y EndIf shape[s2] = shp2 pattern[p2][s] = s2 s2 = s2 + 1 EndFor EndSub Sub RotatePoint ' param x, y - point to rotate ' param angle - rotate angle ' param cx, cy - rotate center ' return x, y - rotated point lx = x - cx ly = y - cy _a = Math.GetRadians(angle) x = Math.Round((Math.Cos(_a) * lx - Math.Sin(_a) * ly)*100)/100 y = Math.Round((Math.Sin(_a) * lx + Math.Cos(_a) * ly)*100)/100 x = x + cx y = y + cy EndSub End>QRW232.sb< Start>QRW993.sb< ' Draw Arc ' Version 0.2 ' Copyright © 2016 Nonki Takahashi. The MIT License. ' GraphicsWindow.PenWidth = 20 GraphicsWindow.PenColor = "Red" GraphicsWindow.BrushColor = "Black" param = "x=315;y=150;r=200;a1=0;a2=180;da=10;ct=Round" DrawArc() d = 30 GraphicsWindow.FillEllipse(240 - d / 2, 100 - d / 2, d, d) GraphicsWindow.FillEllipse(390 - d / 2, 100 - d / 2, d, d) Sub DrawArc ' param["x"] - center x coordinate [px] ' param["y"] - center y coordinate [px] ' param["r"] - radius [px] ' param["a1"] - start angle [°] ' param["a2"] - end angle [°] ' param["da"] - delta (step) angle [°] ' param["ct"] - cap type ("Round" for round, otherwise for flat) Stack.PushValue("local", local) Stack.PushValue("local", a) local["pw"] = GraphicsWindow.PenWidth local["bc"] = GraphicsWindow.BrushColor GraphicsWindow.BrushColor = GraphicsWindow.PenColor For a = param["a1"] To param["a2"] Step param["da"] local["rad"] = Math.GetRadians(a) local["x2"] = param["x"] + param["r"] * Math.Cos(local["rad"]) local["y2"] = param["y"] + param["r"] * Math.Sin(local["rad"]) If param["a1"] < a Then GraphicsWindow.DrawLine(local["x1"], local["y1"], local["x2"], local["y2"]) EndIf If ((param ["a1"] < a) And (a < param["a2"])) Or Text.ConvertToLowerCase(param["ct"]) = "round" Then GraphicsWindow.PenWidth = 0 GraphicsWindow.FillEllipse(local["x2"] - local["pw"] / 2, local["y2"] - local["pw"] / 2, local["pw"], local["pw"]) GraphicsWindow.PenWidth = local["pw"] EndIf local["x1"] = local["x2"] local["y1"] = local["y2"] EndFor GraphicsWindow.BrushColor = local["bc"] a = Stack.PopValue("local") local = Stack.PopValue("local") EndSub End>QRW993.sb< Start>QRX067.sb< ' Let It Be ' Music by John Lennon & Paul McCartney ' Arranged by Nonki Takahashi GraphicsWindow.Title = "LET IT BE" Init() Play() Sub CopyNote iTarget = param["target"] For i = param["from"] To param["to"] note[iTarget] = note[i] iTarget = iTarget + 1 EndFor EndSub Sub Init chord["C"] = "E64G64>C4<" chord["C(2)"] = "C64E64G4" chord["C(3)"] = "<>E64G4" chord["C(4)"] = "C64E4" chord["C(5)"] = "E64G4" chord["C(6)"] = "G4" chord["C(7)"] = "E4" chord["C(8)"] = "G64>E2<" chord["C(9)"] = "<>E64G64>C2<" chord["Dm7"] = "D64F64<>" chord["Dm7(2)"] = "D64F4" chord["Dm7(3)"] = "A64>F4<" chord["Em"] = "E64G4" chord["Em(2)"] = "B64>G4<" chord["F"] = "C64D64A4" chord["F(2)"] = "F64A4" chord["F(3)"] = "C64F64A4" chord["F(4)"] = "A4" chord["F(5)"] = ">C64A2<" chord["F(6)"] = "<>F64>C4<" chord["F(7)"] = "<>F64A64>C2<" chord["G"] = "D64G64B4" chord["G(2)"] = "D64G4" chord["G(3)"] = "<>G64B64>D2<" chord["Am"] = "C64E64A4" chord["Am(2)"] = "C64E64A64<>" chord["Bb"] = "<>F64>D4<" ' ---- [1] note[1] = "O5" note[2] = chord["C"] ' C note[3] = "" note[4] = chord["C"] note[5] = "" note[6] = chord["G"] ' G note[7] = "<>" note[8] = chord["G"] note[9] = "<>" ' [2] note[10] = chord["Am"] ' Am note[11] = "<>" note[12] = chord["Am"] note[13] = chord["Am(2)"] note[14] = chord["Am"] ' F note[15] = "<>" note[16] = chord["F"] note[17] = "<>" ' [3] note[18] = chord["C(2)"] ' C note[19] = "" note[20] = chord["C(2)"] note[21] = "" note[22] = chord["G(2)"] ' G note[23] = "<>" note[24] = chord["G(2)"] note[25] = "<>" ' [4] note[26] = chord["F(2)"] ' F note[27] = "<>" note[28] = chord["C(3)"] ' C note[29] = chord["Dm7(2)"] ' Dm7 note[30] = chord["C(4)"] ' C note[31] = "" note[32] = "" note[33] = "" lyric[26] = " When I" ' ---- [5] note[34] = chord["C(5)"] ' C note[35] = "" note[36] = chord["C(5)"] note[37] = "" note[38] = chord["G(2)"] ' G note[39] = "<>" note[40] = chord["G(2)"] note[41] = "<>" lyric[34] = "find myself in times of trouble" ' [6] note[42] = chord["Am"] ' Am note[43] = "<>" note[44] = chord["Am"] note[45] = "<>" note[46] = chord["F(3)"] ' F note[47] = "<>" note[48] = chord["F(3)"] note[49] = "<>" lyric[42] = "Mother Mary comes to me" ' [7] param = "from=34;to=41;target=50;" CopyNote() lyric[50] = "Speaking words of wisdom, let it" ' [8] note[58] = chord["F(4)"] ' F note[59] = "<>" note[60] = chord["C(6)"] ' C note[61] = chord["Dm7(2)"]' Dm7 note[62] = chord["C(7)"] ' C note[63] = "" lyric[58] = "be. And" ' [9] param = "from=34;to=41;target=64;" CopyNote() lyric[64] = "in my hour of darkness She is stand-" ' [10] param = "from=42;to=49;target=72;" CopyNote() lyric[72] = "ing right in front of me" ' [11] param = "from=50;to=57;target=80;" CopyNote() lyric[80] = "Speaking words of wisdom, let it" ' [12] param = "from=58;to=61;target=88;" CopyNote() note[92] = chord["C(5)"] note[93] = "<>" note[94] = "C64E64G4<>" lyric[88] = "be. Let it be," ' [13] note[95] = chord["Am"] ' Am note[96] = "<>" note[97] = chord["Am"] note[98] = "<>" note[99] = chord["Em"] ' Em note[100] = "<>" note[101] = chord["Em"] note[102] = "<>" lyric[95] = " let it be, Let it be," ' [14] note[103] = chord["F(3)"] ' F note[104] = "<>" note[105] = chord["F(3)"] note[106] = "<>" note[107] = chord["C(5)"] ' C note[108] = "" note[109] = chord["C(5)"] note[110] = "" lyric[103] = "let it be." ' [15] param = "from=18;to=25;target=111;" CopyNote() lyric[111] = "Wisper words of wisdom, let it" ' [16] param = "from=26;to=33;target=119;" CopyNote() lyric[119] = "be. And when" ' ---- [5] param = "from=34;to=41;target=127;" CopyNote() lyric[127] = "the broken hearted people" ' [6] param = "from=42;to=49;target=135;" CopyNote() lyric[135] = "Living in the world agree" ' [7] param = "from=34;to=41;target=143;" CopyNote() lyric[143] = "There will be an answer, let it" ' [8] param = "from=58;to=63;target=155;" CopyNote() lyric[155] = "be. And" ' [9] param = "from=34;to=41;target=163;" CopyNote() lyric[163] = "though they may be parted there is" ' [10] param = "from=42;to=49;target=171;" CopyNote() lyric[171] = "Still a chance that they will see" ' [11] param = "from=34;to=41;target=179;" CopyNote() lyric[179] = "There will be an answer, let it" ' [12] param = "from=88;to=94;target=187;" CopyNote() lyric[187] = "be. Let it be," ' [13] param = "from=95;to=102;target=194;" CopyNote() lyric[194] = " let it be, Let it be," ' [14] param = "from=103;to=110;target=202;" CopyNote() lyric[202] = " let it be. Yeah" ' [15] param = "from=18;to=25;target=210;" CopyNote() lyric[210] = "there will be an answer, let it" ' [17] param = "from=26;to=33;target=218;" CopyNote() lyric[218] = "be. Let it be," ' [18] param = "from=95;to=102;target=226;" CopyNote() lyric[226] = " let it be, Let it be, ' [19] param = "from=103;to=110;target=234;" CopyNote() lyric[234] = " let it be." ' [20] param = "from=34;to=41;target=242;" CopyNote() lyric[242] = "Wisper words of wisdom, let it" ' [21] param = "from=58;to=62;target=250;" CopyNote() note[255] = "" lyric[250] = "be." ' [22] note[256] = chord["F(5)"] ' F note[257] = chord["Em(2)"] ' Em note[258] = chord["Dm7(3)"] ' Dm7 note[259] = chord["C(8)"] ' C note[260] = chord["Bb"] ' Bb note[261] = chord["F(6)"] ' F lyric[256] = "(Instrumental)" ' [23] note[262] = chord["G(3)"] ' G note[263] = chord["F(7)"] ' F note[264] = chord["C(9)"] ' C note[265] = "<>" ' C ' [24] note[266] = chord["F(5)"] ' F note[267] = chord["Em(2)"] ' Em note[268] = chord["Dm7(3)"] ' Dm7 note[269] = chord["C(8)"] ' C note[270] = chord["Bb"] ' Bb note[271] = chord["F(6)"] ' F ' [25] note[272] = chord["G(3)"] ' G note[273] = chord["F(7)"] ' F note[274] = chord["C(9)"] ' C note[275] = "<>" ' C ' [26] param = "from=34;to=41;target=276;" CopyNote() ' [27] param = "from=42;to=49;target=284;" CopyNote() ' [28] param = "from=34;to=41;target=292;" CopyNote() ' [29] param = "from=58;to=63;target=300;" CopyNote() ' [30] param = "from=34;to=41;target=306;" CopyNote() ' [31] param = "from=42;to=49;target=314;" CopyNote() ' [32] param = "from=34;to=41;target=322;" CopyNote() ' [33] param = "from=88;to=94;target=330;" CopyNote() lyric[330] = " Let it be," ' [34] param = "from=95;to=102;target=337;" CopyNote() lyric[337] = " let it be, Let it be, ' [35] param = "from=103;to=110;target=345;" CopyNote() lyric[345] = " let it be." ' [36] param = "from=18;to=25;target=363;" CopyNote() lyric[363] = "Wisper words of wisdom, let it" ' [37] param = "from=26;to=33;target=371;" CopyNote() lyric[371] = "be. And when" ' ---- [38] param = "from=34;to=41;target=379;" CopyNote() lyric[379] = "the night is cloudy, There is" ' [39] param = "from=42;to=49;target=387;" CopyNote() lyric[387] = "still a light that shines on me," ' [40] param = "from=34;to=41;target=395;" CopyNote() lyric[395] = "Shine until tomorrow, let it" ' [41] param = "from=58;to=63;target=403;" CopyNote() lyric[403] = "be. I" ' [42] param = "from=34;to=41;target=409;" CopyNote() lyric[409] = "wake up to the sound of music" ' [43] param = "from=42;to=49;target=417;" CopyNote() lyric[417] = "Mother Mary comes to me" ' [44] param = "from=34;to=41;target=425;" CopyNote() lyric[425] = "Speaking words of wisdom, let it" ' [45] param = "from=88;to=94;target=433;" CopyNote() lyric[433] = "be. Let it be," ' [46] param = "from=95;to=102;target=440;" CopyNote() lyric[440] = " let it be, Let it be," ' [47] param = "from=103;to=110;target=448;" CopyNote() lyric[448] = " let it be," ' [48] param = "from=34;to=41;target=456;" CopyNote() lyric[456] = "There will be an answer, let it" ' [49] param = "from=88;to=94;target=464;" CopyNote() lyric[464] = "be. Let it be," ' [46] param = "from=95;to=102;target=471;" CopyNote() lyric[471] = " let it be, Let it be," ' [47] param = "from=103;to=110;target=479;" CopyNote() lyric[479] = " let it be," ' [48] param = "from=34;to=41;target=487;" CopyNote() lyric[487] = "There will be an answer, let it" ' [49] param = "from=88;to=94;target=495;" CopyNote() lyric[495] = "be. Let it be," ' [46] param = "from=95;to=102;target=502;" CopyNote() lyric[502] = " let it be, Let it be," ' [47] param = "from=103;to=110;target=510;" CopyNote() lyric[510] = " let it be," ' [48] param = "from=34;to=41;target=518;" CopyNote() lyric[518] = "Whisper words of wisdom, let it" ' [50] param = "from=250;to=255;target=526;" CopyNote() lyric[526] = "be. ' [51] param = "from=266;to=271;target=532;" CopyNote() ' [52] note[540] = chord["G(3)"] ' G note[541] = chord["F(7)"] ' F note[542] = chord["C(9)"] ' C GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 24 GraphicsWindow.DrawText(90, 10, "The Beatles") GraphicsWindow.FontSize = 100 GraphicsWindow.DrawText(90, 50, "LET IT BE") GraphicsWindow.FontSize = 18 GraphicsWindow.FontBold = "False" GraphicsWindow.DrawText(90, 180, "Music by John Lennon & Paul McCartney") GraphicsWindow.DrawText(90, 210, "Arranged by Nonki Takahashi") GraphicsWindow.FontName = "Consolas" GraphicsWindow.FontBold = "True" GraphicsWindow.FontSize = 24 GraphicsWindow.BrushColor = "Lime" txt[1] = Shapes.AddText("") txt[2] = Shapes.AddText("") iTxt = 1 Timer.Interval = 40 Timer.Tick = OnTick EndSub Sub OnTick For it = 1 To 2 x = Shapes.GetLeft(txt[it]) y = Shapes.GetTop(txt[it]) Shapes.Move(txt[it], x - 10, y) EndFor EndSub Sub Play n = Array.GetItemCount(note) index = Array.GetAllIndices(note) For i = 1 To n If lyric[index[i]] <> "" Then Shapes.Move(txt[iTxt], 640, 390) Shapes.SetText(txt[iTxt], lyric[index[i]]) iTxt = 3 - iTxt EndIf Sound.PlayMusic(note[index[i]]) EndFor EndSub End>QRX067.sb< Start>QRZ176.sb< GraphicsWindow.BrushColor="darkblue GraphicsWindow.BackgroundColor="teal GraphicsWindow.PenWidth=0 GraphicsWindow.Title="BlockChars args=0 dy=-50 sc=1 Sub fss LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) EndSub Sub uss LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) EndSub fss()'-------i LDCall.Function4 ("radd" 20 10 90+dx 100+dy) LDCall.Function4 ("cadd" 30 30 100+dx 60+dy) dx=60'------n fss() LDCall.Function4 ("radd" 80 10 90+dx 100+dy) dx=120 fss() dx=180'------l LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) dx=240'------o LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 120+dx 180+dy) LDCall.Function4 ("radd" 50 10 120+dx 100+dy) dx=300 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) dx=360'------t LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) GraphicsWindow.BrushColor="teal LDCall.Function4 ("cadd" 40 40 80+dx 40+dy) GraphicsWindow.BrushColor="darkblue LDCall.Function4 ("radd" 20 10 120+dx 100+dy) dx=420'------h LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) LDCall.Function4 ("radd" 70 10 100+dx 100+dy) dx=480 fss() dx=540'------m fss() LDCall.Function4 ("radd" 140 10 90+dx 100+dy) dx=600 fss() dx=660 fss() dx=0'----------u dy=100 uss() LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=60 uss() dx=120'----------w uss() LDCall.Function4 ("radd" 120 10 120+dx 180+dy) dx=dx+60 uss() dx=dx+60 uss() dx=dx+60 '----y uss() LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) dx=dx+60 '----q LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) dx=dx+60'-----j LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) LDCall.Function4 ("cadd" 30 30 100+dx 60+dy) dx=dx+60 '----p LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDEvents.MouseWheel=mww GraphicsWindow.MouseMove =mdd Sub mdd If Mouse.IsLeftButtonDown Then LDGraphicsWindow.Reposition (sc sc ldGraphicsWindow.RepositionedMouseX/sc-100/sc ldGraphicsWindow.RepositionedMouseY/sc-100/sc aa) EndIf EndSub Sub mww If Mouse.IsRightButtonDown Then aa=aa+ LDEvents.LastMouseWheelDelta*3 else sc=sc+ LDEvents.LastMouseWheelDelta/15 EndIf LDGraphicsWindow.Reposition (sc sc 0 0 aa) EndSub Sub radd pp=Shapes.AddRectangle (args[1] args[2]) Shapes.Move (pp args[3] args[4]) LDShapes.AnimateOpacity (pp 1500 5) EndSub Sub cadd pp=Shapes.AddEllipse (args[1] args[2]) Shapes.Move (pp args[3] args[4]) EndSub End>QRZ176.sb< Start>QRZ621.sb< 'Racing game skeleton - Proof of Concept. 'Written using Microsoft Small Basic 'Software designed and coded by Anthony Yarrell '___________________________________________________________ 'Setup Graphics window: GraphicsWindow.CanResize = "False GraphicsWindow.Title = "Driving Game Skeleton" GraphicsWindow.Width = 600 GraphicsWindow.Height = 500 Timer.Interval=120 '< - 60 is the minimum Timer.Pause() Timer.Tick=FrameCounterUpdate '____________________________________________________________ 'Indexes into the 2D animation queue array: xx = 0 'Holds center X of road yy = 1 'Holds center Y of road ww = 2 'Holds width of road segments hh = 3 'Holds height of road segments iRef = 4 'Reference to Shape object to animate as it moves though the queue zFac = 5 'Zoom factor of shapes as they move though the queue. Used to give the illusion that the object is getting closer lRoadLineRef = 6 'Reference to image used to draw left-side of the road rRoadLineRef = 7 'Reference to image used to draw right-side of the road centerStripeRef = 8 'Reference to image used to draw center road stripes '_____________________________________________________________ 'Starting/default values: roadWidth = 600 '800-900 is optimal road width roadHeight = 100 lastSegment = 7 'Number of invisible road segments firstSegment = 0 frameCounter = 1 screenY = 350 screenX = 200 curve = 0 '0=straight, + value = right curve, - value = left curve ' Queue[lastSegment][ww] = roadWidth Queue[lastSegment][hh] = roadHeight Queue[lastSegment][xx] = 100 Queue[lastSegment][yy] = 100 Queue[lastSegment][zFac] = 2 '____________________________________________________________ 'MAIN GAME SECTION: DrawBackground() CreateCityScape() CreateRoadSripes() BuildRoadDataStructure() DrawRoadBoundaries() hillValue=0 GAME_OVER = "False" Timer.Resume() '_____________________________________________________________ Sub FrameCounterUpdate frameCounter = frameCounter + 1 GameLoop() EndSub '__________________________________________________________________ Sub GameLoop 'Animate moving imges toward the player (camera): ShiftMovingImageQueue() AnimateImagesInQueue() '**********START OF DEMO**********' 'After 100 frames curve the road left for 10 frames and then hold: If (frameCounter >100 And frameCounter < 110) Then curve=curve+1.5 EraseRoadBoundaries() BuildRoadDataStructure() DrawRoadBoundaries() endif 'Scroll the background cityspace left if the round curves right 'or right if the road curves left: If (curve > 0) Then directionFlag = "LEFT" ShiftBackgroundImageQueue() MoveBackgroundImages() elseIf (curve < 0) Then directionFlag = "RIGHT" ShiftBackgroundImageQueue() MoveBackgroundImages() EndIf 'Now, after 100 additional frames, curve the road back the right for 20 frames then hold: If (frameCounter >210 And frameCounter < 230) Then curve=curve-1.5 EraseRoadBoundaries() BuildRoadDataStructure() DrawRoadBoundaries() EndIf 'Finally, after 350 frames, end the demo If (frameCounter >= 350) Then GAME_OVER = "True" Timer.Pause() EndIf '*******END OF DEMO**************** endsub '_____________________________________________________________ 'Build road data structure: Sub BuildRoadDataStructure For i = lastSegment To firstSegment+1 Step -1 Queue[i-1][ww] = (Queue[i][ww] * 0.5) Queue[i-1][hh] = (Queue[i][hh] * 0.5) - hillValue Queue[i-1][yy] = (Queue[i][yy] - Queue[i][hh]) Queue[i-1][xx] = (Queue[i][xx] - curve) Queue[i-1][zFac] = Queue[i][zFac] - 0.5 EndFor EndSub '_____________________________________________________________ 'Draw road border lines: Sub DrawRoadBoundaries GraphicsWindow.PenWidth=2 GraphicsWindow.PenColor="white" For i = lastSegment To firstSegment+1 Step -1 x1 = (Queue[i-1][xx] + screenX) + (Queue[i-1][ww] * 0.5) y1 = (Queue[i-1][yy] + screenY) x2 = (Queue[i][xx] + screenX) + (Queue[i][ww] * 0.5) y2 = (Queue[i][yy] + screenY) Queue[i][lRoadLineRef]=Shapes.AddLine(x1,y1,x2,y2) x1 = (Queue[i-1][xx] + screenX) - (Queue[i-1][ww] * 0.5) y1 = (Queue[i-1][yy] + screenY) x2 = (Queue[i][xx] + screenX) - (Queue[i][ww] * 0.5) y2 = (Queue[i][yy] + screenY) Queue[i][rRoadLineRef]=Shapes.AddLine(x1,y1,x2,y2) EndFor EndSub '------------------------------------------------------------------------------------------------------------- Sub EraseRoadBoundaries For i = lastSegment To firstSegment+1 Step -1 Shapes.Remove(Queue[i][lRoadLineRef]) Shapes.Remove(Queue[i][rRoadLineRef]) EndFor EndSub '------------------------------------------------------------------------------------------------------------- 'Shift register queue that moves images from the vanishing point toward 'the player: Sub ShiftMovingImageQueue _temp1 = Queue[lastSegment][iRef] _temp2 = Queue[lastSegment][centerStripeRef] For i = lastSegment To firstSegment+1 Step -1 Queue[i][iRef] = Queue[i-1][iRef] Queue[i][centerStripeRef] = Queue[i-1][centerStripeRef] endfor Queue[firstSegment][iRef] = _temp1 Queue[firstSegment][centerStripeRef] = _temp2 EndSub '_________________________________________________________________ 'This is a bi-directional shift register queue that allows the backround images to scroll left 'or right: Sub ShiftBackgroundImageQueue _bottomSegment = 64 _topSegment = 0 If (directionFlag = "LEFT") then _temp1 = BackgroundImageQueue[_bottomSegment] For i = _bottomSegment To _topSegment+1 Step -1 BackgroundImageQueue[i] = BackgroundImageQueue[i-1] endfor BackgroundImageQueue[_topSegment] = _temp1 ElseIf (directionFlag = "RIGHT") then _temp1 = BackgroundImageQueue[_topSegment] For i = _topSegment to _bottomSegment -1 BackgroundImageQueue[i] = BackgroundImageQueue[i+1] endfor BackgroundImageQueue[_bottomSegment] = _temp1 EndIf EndSub '_________________________________________________________________ 'Draws the background images off in the distance: Sub MoveBackgroundImages xxxx = 0 yyyy = 238 For i = _topSegment To _bottomSegment Shapes.Move(BackgroundImageQueue[i], xxxx, yyyy) xxxx = xxxx + 10 EndFor EndSub '---------------------------------------------------------------------------------------------------------------- 'Each array element in the queue array holds data used to position and zoom graphical items 'on the screen and each element corresponds to a different XY postition and zoom value. 'When items are shifted in the queue, the code below draws the objects to their new 'XY positions with the correct zoom values. This gives the illusion that the object 'is moving toward you as its Y value increases. ' 'It doesn't matter whether the graphic object is a Shape object or a Bitmap - as long as a reference 'to the image is stored somewhere in the queue using one of the reference variables, it will be animated: Sub AnimateImagesInQueue For aCounter=firstSegment To lastSegment 'Animate any objects on the side of the road (houses, trees, signs, etc): x1 = (Queue[aCounter][xx] + screenX) + (Queue[aCounter][ww] * 0.5) y1 = (Queue[aCounter][yy] + screenY) + (Queue[aCounter][ww] * 0.5) Shapes.Zoom(Queue[aCounter][iRef], Queue[aCounter][zFac], Queue[aCounter][zFac]) Shapes.Move(Queue[aCounter][iRef], x1, y1) 'Animate the center road stripes: x1 = (Queue[aCounter][xx] + screenX) y1 = (Queue[aCounter][yy] + screenY) Shapes.Zoom(Queue[aCounter][centerStripeRef], 3, Queue[aCounter][zFac]*2.5) Shapes.Move(Queue[aCounter][centerStripeRef], x1, y1) EndFor EndSub '______________________________________________________________________ 'Draws images in the background that represents mountains, buildings, landscapes that are off in the 'distance and adds them to the background image queue. The Shape objects are stand-ins for the 'actual bitmap images: Sub CreateCityScape GraphicsWindow.BrushColor="black" GraphicsWindow.PenColor="black" BackgroundImageQueue[1] = Shapes.AddRectangle(20,15) BackgroundImageQueue[3] = Shapes.AddRectangle(10,15) BackgroundImageQueue[5] = Shapes.AddRectangle(30,15) BackgroundImageQueue[10] = Shapes.AddRectangle(10,15) BackgroundImageQueue[20] = Shapes.AddRectangle(50,15) BackgroundImageQueue[25] = Shapes.AddRectangle(10,15) BackgroundImageQueue[35] = Shapes.AddRectangle(50,15) BackgroundImageQueue[40] = Shapes.AddRectangle(0,15) BackgroundImageQueue[45] = Shapes.AddRectangle(20,15) BackgroundImageQueue[55] = Shapes.AddRectangle(30,15) ShiftBackgroundImageQueue() MoveBackgroundImages() EndSub '_____________________________________________________________________ 'Initailize center road stripes and add them to the animation queue. The Shape objects are stand-ins 'for the actual bitmap objects: Sub CreateRoadSripes GraphicsWindow.PenColor="yellow" GraphicsWindow.PenWidth=1 For i = firstSegment To lastSegment Step 3 Queue[i][centerStripeRef] = Shapes.AddRectangle(1,4) EndFor EndSub '______________________________________________________________________ 'This is where the clouds and sky would be drawn: Sub DrawBackground GraphicsWindow.BackgroundColor="gray" '<-road color GraphicsWindow.BrushColor="skyblue" '<-sky color GraphicsWindow.FillRectangle(0,0,640,253) 'Clouds: GraphicsWindow.PenColor="white" GraphicsWindow.BrushColor="white" For i = 1 To 10 cloudX = Math.GetRandomNumber(800) cloudY= Math.GetRandomNumber(200) GraphicsWindow.fillEllipse(cloudX, cloudY, 40, 10) GraphicsWindow.fillEllipse(cloudX+10, cloudY + 10, 40, 10) GraphicsWindow.fillEllipse(cloudX+40, cloudY, 40, 10) EndFor EndSub End>QRZ621.sb< Start>QSC137.sb< GraphicsWindow.MouseDown = OnMouseDown Sub OnMouseDown Program.End() EndSub begin: TextWindow.WriteLine("Would you like the turtle to turn or move and how much or would you like it to draw a shape? ") action = TextWindow.Read() number = TextWindow.ReadNumber() If action = "move" Then Turtle.Move(number) ElseIf action = "turn" then Turtle.Turn(number) Elseif action = "shape" then TextWindow.WriteLine("dotted or single line ") type = TextWindow.Read() If type = "single line" then Goto singleline elseif type = "dotted" then Goto dotted Else TextWindow.WriteLine("Invalid input") Goto begin singleline: TextWindow.WriteLine("How many sides and what size? ") sides = TextWindow.ReadNumber() angle = 360 / sides sides = Math.Abs(sides) size = TextWindow.ReadNumber() / sides For i = 1 to sides Turtle.Move(size) Turtle.Turn(angle) endfor EndIf Goto clear dotted: TextWindow.WriteLine("How many sides and what size and how many line segments should each line have?(type each variable on seperate lines) ") sides = TextWindow.ReadNumber() angle = 360 / sides sides = Math.Abs(sides) size = TextWindow.ReadNumber() / sides segments = TextWindow.ReadNumber() For i = 1 To sides For j = 1 To segments Turtle.Move(size) Turtle.PenUp() Turtle.Move(size) Turtle.PenDown() EndFor Turtle.Turn(angle) EndFor elseif action = "clear" then GraphicsWindow.Clear() Goto begin Else Program.End() EndIf Goto clear clear: TextWindow.WriteLine("Would you like to clear the window? ") ans = TextWindow.Read() If ans = "yes" Or "y" Or "Yes" Or "Y" Then GraphicsWindow.Clear() ElseIf ans = "no" Or "n" Or "No" Or "N" Then EndIf Goto begin End>QSC137.sb< Start>QSD290-1.sb< ' Challenge of the Month - October 2013 Write a simple Month Calendar in TW by NaochanON ' Gregorian calendar Start date 1582/10/15= Friday QSD290-1 Months="1=Jan;2=Feb;3=Mar;4=Apr;5=May;6=Jun;7=Jul;8=Aug;9=Sep;10=Oct;11=nov;12=Dec" Days="1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31" Weekdays="1=Sun;2=Mon;3=Tue;4=Wes;5=Thu;6=Fri;7=Sat" TextWindow.Write(" Input year , month Ex; 2013,9 " ) YearMonth= TextWindow.Read() TextWindow.WriteLine(" ") GetWeekday() Show_Calender() Sub Show_Calender TextWindow.CursorLeft=5 TextWindow.WriteLine("Calender of "+YearMonth+" "+" // "+Months[B]) For i=1 To 7 TextWindow.CursorLeft=5+(i-1)*5 TextWindow.Write(Weekdays[i]) EndFor TextWindow.WriteLine(" ") If B=2 Then ' if Feb Y=A GetPLUS() ' gets PLUS =0 or 1 endif For j=Lastday+1 To days[B]+Lastday+PLUS K= Math.Remainder(j-1,7) TextWindow.CursorLeft=5+5*K TextWindow.Write(text.GetSubTextToEnd(100+j-lastday,2)) If K=6 Then TextWindow.WriteLine(" ") EndIf EndFor TextWindow.WriteLine(" ") endsub Sub GetWeekday midP=Text.GetIndexOf(YearMonth,",") A= Text.GetSubText(YearMonth,1,midP-1)*1 ' Year >=1583 B= Text.GetSubTextToEnd(YearMonth,midP+1)*1 ' Month Sumdays=365*(A-1583) For Y=1583 To A-1 getplus() sumdays=sumdays+PLUS ' previous year Endfor For j=1 To B-1 sumdays=sumdays+Days[j] EndFor Y=A getplus() If B>2 then sumdays=sumdays+PLUS EndIf Lastday= Math.Remainder(sumdays+6,7) ' last weekday 1583/01/01=Saturday =Weekdays[1+6] endsub Sub getplus PLUS=0 If (Math.Remainder(Y,4)=0 And Math.Remainder(Y,100)<>0) Or Math.Remainder(Y,400)=0 Then PLUS=1 EndIf EndSub End>QSD290-1.sb< Start>QSD627.sb< LDControls.ListBoxItemChanged = OnListBoxItemchanged Controls.ButtonClicked = OnButtonClicked GraphicsWindow.KeyUp = OnKeyUp T = "True" F = "False" Back = Controls.AddButton("Back", 10, GraphicsWindow.Height - 30) ' Define ListBox LBlist[1] = "TEXT" LBlist[2] = "NUM" ListBox = LDControls.AddListBox(LBlist, 100, 200) Controls.HideControl(ListBox) Controls.Move(ListBox, 200,100) 'Define ListView heads[1] = "Field" heads[2] = "Data type" ListView = LDControls.AddListView(400,200,heads) LDControls.ListViewEdit(ListView, T) 'Fill ListView list[1][1] = "licence tag" list[1][2] = "TEXT" ' I dont know the command PEnd = F While PEnd = F CheckEvents() EndWhile Program.End() Sub CheckEvents If OLBIC = T Then OLBIC = F 'actual colum head data typ show listbox and wait for select 'Set the select item from the listbox in the listviewfield EndIf If OKU = T Then OKU = F If GraphicsWindow.LastKey = "Return" Then ' Set cursor into then next Field (next column if last column then next row first column) EndIf EndIf If OBC = T Then If Controls.LastClickedButton = Back Then PEnd = T EndIf EndIf EndSub Sub OnButtonClicked OBC = T EndSub Sub OnListBoxItemchanged OLBIC = T EndSub Sub OnKeyUp OKU = T EndSub End>QSD627.sb< Start>QSF345.sb< GraphicsWindow.Title = "* * * Match Sticks * * * " GraphicsWindow.BackgroundColor = "Black" GraphicsWindow.Width = 620 GraphicsWindow.Height = 360 Turtle.Speed = 10 GameKey=25 For i = 26 To 598 Step 26 GraphicsWindow.PenColor = "Moccasin" GraphicsWindow.PenWidth = 6 Turtle.X = i Turtle.Y = 72 Turtle.MoveTo(i,220) GraphicsWindow.PenColor = "red" GraphicsWindow.PenWidth = 8 GraphicsWindow.DrawLine(i,60,i,71) Sticks=Sticks + 1 endfor X= 624 Turtle.Hide() Turtle.Speed = 9 GraphicsWindow.DrawText(30,230,"You and the computer take turns drawing 1,2 or 3 match sticks.") GraphicsWindow.DrawText(30,245,"who ever draws the last one is the looser.") GraphicsWindow.DrawText(30,260,"Do you want me to go first? (Y/N)") GraphicsWindow.KeyDown = TextInput1 Sub TextInput1 Key=GraphicsWindow.LastKey If Sticks = 23 then 'If Key="Y" Or Key="N" then I marked three lines out, because they are doubled. If Key = "Y" Then ComputersTurn() PlayersTurn() 'EndIf ElseIf Key = "N" Then PlayersTurn() 'EndIf Else GraphicsWindow.ShowMessage("You pressed somthing other than y or n","Input Error") EndIf EndIf EndSub Sub PlayersTurn GraphicsWindow.KeyDown = TextInput2 GraphicsWindow.BrushColor = "Black" GraphicsWindow.FillRectangle(30,230, 400, 60) GraphicsWindow.BrushColor = "Green" GraphicsWindow.DrawText(30,260,"Please press number key 1,2,3 or Q to quit and R to reset.") EndSub Sub ComputersTurn If Sticks = GameKey then Qty = Math.GetRandomNumber(3) If Sticks=1 Then Qty=1 EndIf GraphicsWindow.ShowMessage("Computer draws " + Qty,"Computers Turn") RemoveStick() GameKey=GameKey-4 If Sticks<1 Then GraphicsWindow.ShowMessage("Looks like you got lucky that time.","Computer Lost") Program.End() EndIf Else GameKey=GameKey-4 Qty=Sticks-GameKey If Qty=0 Then Qty = Math.GetRandomNumber(3) EndIf If Sticks=1 Then Qty=1 EndIf GraphicsWindow.ShowMessage("Computer draws " + Qty,"Computers Turn") RemoveStick() If Sticks<1 Then GraphicsWindow.ShowMessage("Looks like you got lucky that time.","Computer Lost") Program.End() EndIf 'GraphicsWindow.ShowMessage("Sticks = " + Sticks + " GameKey = " + GameKey,"Computer Winning!") EndIf EndSub Sub TextInput2 Key=GraphicsWindow.LastKey If (Key="D1" Or Key="D2" Or Key="D3" Or Key="Q" Or Key="R") then 'This Lines will convert the pressed key to the right number START If Key="D1" Then Key=1 ElseIf Key="D2" Then Key=2 ElseIf Key="D3" Then Key=3 EndIf 'This Lines will convert the pressed key to the right number END Qty=Key RemoveStick() If Sticks<1 Then GraphicsWindow.ShowMessage("I WIN, YOU LOOSE","Computer Wins!") Program.End() EndIf ComputersTurn() Else GraphicsWindow.ShowMessage("You pressed somthing other than 1,2 or 3","Input Error") EndIf EndSub Sub RemoveStick 'GraphicsWindow.ShowMessage(Qty + " Sticks to be removed","RemoveStick") For D = Qty To 1 step - 1 X=X-26 Sticks=Sticks - 1 GraphicsWindow.PenColor = "Black" GraphicsWindow.PenWidth = 8 Turtle.X = X Turtle.Y = 60 Turtle.MoveTo(X,220) EndFor EndSub End>QSF345.sb< Start>QSF666-0.sb< GraphicsWindow.Title = "Ferma's spiral GraphicsWindow.BackgroundColor ="darkblue GraphicsWindow.Width=600 GraphicsWindow.Height=500 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.PenWidth=0 GraphicsWindow.BrushColor ="yellow base=0.0000000001 ' to avoid zero dividion // Math.Arctan( zero ) stp=0.05 a=70 X0=300 Y0=250 X1=X0 Y1=Y0 i=0 c=577 For s=0 To 31.87 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s) Y=Y0+r*math.Sin(-s) pp[c+i][1]=X pp[c+i][2]=y i=i+1 EndFor i=c-1 For s=0 To 28.7 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s-3.14192) Y=Y0+r*math.Sin(-s-3.14192) pp[i][1]=X pp[i][2]=y i=i-1 EndFor For t=1 To Array.GetItemCount (pp) qq[t][1]=pp[t][1] qq[t][2]=pp[t][2] EndFor ss=LDShapes.AddPolygon (qq) While "true aa=aa+.5 LDShapes.RotateAbout (ss X0 Y0 aa) Program.Delay (2) EndWhile End>QSF666-0.sb< Start>QSF666-1.sb< GraphicsWindow.Title = "Ferma's spiral GraphicsWindow.BackgroundColor ="darkblue GraphicsWindow.Width=600 GraphicsWindow.Height=500 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.PenWidth=0 GraphicsWindow.BrushColor ="yellow base=0.0000000001 ' to avoid zero dividion // Math.Arctan( zero ) stp=0.05 a=70 X0=300 Y0=250 X1=X0 Y1=Y0 i=0 c=577 For s=0 To 31.87 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s) Y=Y0+r*math.Sin(-s) pp[c+i][1]=X pp[c+i][2]=y i=i+1 EndFor i=c-1 For s=0 To 28.7 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s-3.14192) Y=Y0+r*math.Sin(-s-3.14192) pp[i][1]=X pp[i][2]=y i=i-1 EndFor For t=1 To Array.GetItemCount (pp) qq[t][1]=pp[t][1] qq[t][2]=pp[t][2] EndFor ss=LDShapes.AddPolygon (qq) While "true aa=aa+.5 LDShapes.RotateAbout (ss X0 Y0 aa) Program.Delay (2) GraphicsWindow.BackgroundColor=LDColours.HSLtoRGB (aa/10,1,0.5) LDShapes.BrushColour (ss,LDColours.HSLtoRGB ( 0 0 math.Abs(LDMath.Sin(aa/4)))) EndWhile End>QSF666-1.sb< Start>QSF666.sb< ' Fermat's spiral Challenge of the Month - June 2016 by NaochanON GraphicsWindow.Show() GraphicsWindow.Width=800 GraphicsWindow.Height=700 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.PenColor="Red" GraphicsWindow.PenWidth=10 base=0.0000000001 ' to avoid zero dividion // Math.Arctan( zero ) stp=0.05 a=70 X0=400 Y0=350 X1=X0 Y1=Y0 For s=0 To 25 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s) Y=Y0+r*math.Sin(-s) GraphicsWindow.DrawLine(x,y,X1,Y1) sita= math.Floor(math.GetDegrees(Math.ArcTan((Y-Y0)/(X-X0+base)))*10)/10 L1=L1+ Math.SquareRoot((X-X1)*(X-X1)+ (Y-Y1)*(Y-Y1)) 'GraphicsWindow.Title="radias= "+math.Floor(r)+" Length= "+math.Floor(L1) X1=X Y1=Y Program.Delay(10) EndFor Program.Delay(1000) GraphicsWindow.PenColor="Blue" X1=X0 Y1=Y0 For s=0 To 25 Step stp r= Math.SquareRoot(a*a*s) X=X0+r*math.Cos(-s-3.14192) Y=Y0+r*math.Sin(-s-3.14192) GraphicsWindow.DrawLine(x,y,X1,Y1) sita= math.Floor(math.GetDegrees(Math.ArcTan((Y-Y0)/(X-X0+base)))*10)/10 L2=L2+ Math.SquareRoot((X-X1)*(X-X1)+ (Y-Y1)*(Y-Y1)) ' GraphicsWindow.Title="radias= "+math.Floor(r)+" Length= "+math.Floor(L2) X1=X Y1=Y Program.Delay(10) EndFor GraphicsWindow.Title=" Points= "+math.floor(25/stp)+" Length 1= "+Math.Floor(L1)+" Length 2= "+Math.Floor(L2)+" : radias= "+math.Floor(r) End>QSF666.sb< Start>QSG771.sb< For i = 1 To 3 TextWindow.Write("insert number "+i+": ") nr[i] = math.Round(TextWindow.ReadNumber()) TextWindow.Clear() EndFor temp[1] = Math.Min(nr[1],nr[2]) min = Math.Min(temp[1],nr[3]) temp[2] = Math.Max(nr[1],nr[2]) max = Math.Max(temp[2],nr[3]) max2 = max min2 = min For i = 1 To 3 If(nr[i] = max2) then nr[i] = "null" max2 = "null" EndIf If(nr[i] = min2) then nr[i] = "null" min2 = "null" EndIf EndFor For i = 1 To 3 If(nr[i] <> "null") Then med = nr[i] EndIf EndFor TextWindow.WriteLine(min+" - "+med+" - "+max) End>QSG771.sb< Start>QSH310.sb< ' SmallBasic Version 1.1 ' Program: MultilangProgram ' Changelog: ' Author: Pappa Lapub ' Website: ' ImportURL: http://smallbasic.com/program/? ' Extension: LitDev ' Comment: https://social.msdn.microsoft.com/Forums/en-US/ac62f8ad-0c1a-46a6-ab42-9cf53fc1a736/how-i-can-add-multi-language-program-? ' ' Variables: ' ToDo: ' ================================================================================ ' The following line could be harmful and has been automatically commented. ' set = File.GetSettingsFilePath() ' The following line could be harmful and has been automatically commented. ' guiTxt = LDFile.ReadANSIToArray(set) lng = 1 ' Default english guiTxt[line][1] lngID = LDUtilities.CurrentCulture If lngID = "de-DE" Then lng = 2 'ElseIf lngID = "what-EVER" Then 'lng = 3 EndIf '' BuildGUI GraphicsWindow.Title = guiTxt[5][lng] btn = Controls.AddButton(guiTxt[1][lng], 20,20) tb = Controls.AddTextBox(20, 100) Controls.SetTextBoxText(tb, guiTxt[2][lng]) Controls.ButtonClicked = OnButtonClick ' ////////// EVENT \\\\\\\\\\ Sub OnButtonClick GraphicsWindow.ShowMessage(guiTxt[3][lng], guiTxt[4][lng]) EndSub End>QSH310.sb< Start>QSL119.sb< GraphicsWindow.BackgroundColor="teal GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.Width=1200 GraphicsWindow.Height=800 Turtle.x=600 Turtle.y=400 Turtle.Speed=10 GraphicsWindow.PenWidth=2 GraphicsWindow.Title="Turtle Loops For mf=0 to 12 vl = 5 hh = 0 ct1 = 0 For ct=0 To 51 hh = LDColours.HSLtoRGB(hi 1 .4) GraphicsWindow.PenColor=hh ww = ww + .5 hi = hi + 2 Turtle.Turn(vl) Turtle.Move(6) vl = vl - .3005 EndFor Endfor End>QSL119.sb< Start>QSP181.sb< 'Double Spiral -- An early endeavor with Small Basic -- Copyright codingCat aka Matthew L. Parets -- No rights reserved as long as no money earned GraphicsWindow.Title = "Double Sprial" GraphicsWindow.Width = GraphicsWindow.Width - 160 Turtle.y = Turtle.Y - 25 Turtle.X = Turtle.X - 90 x = Turtle.X y = Turtle.Y top: Turtle.Angle = 0 Turtle.X = x Turtle.Y = y dist = Math.Power(2,Math.GetRandomNumber(8)-1) GraphicsWindow.PenWidth = (dist/2) limit = (360/0.15625)/dist size = 64 / dist Turtle.Speed = 10 GraphicsWindow.PenColor = GraphicsWindow.GetRandomColor() For i =1 To limit Turtle.Turn(360/(360/10)) Turtle.Move(i/size) EndFor Turtle.X = x - 0 Turtle.Y = y + (35 /(32/dist)) Turtle.Angle = 180 GraphicsWindow.PenColor = GraphicsWindow.GetRandomColor() For i =1 To limit Turtle.Turn(360/(360/10)) Turtle.Move(i/size) EndFor Program.Delay(10000) GraphicsWindow.Clear() Goto top End>QSP181.sb< Start>QSP485.sb< qq["甲"]= "jiă" qq["乙"]= "yĭ" qq["丙"]= "bĭng" qq["丁"]= "dīng" qq["戊"]= "wù" qq["己"]= "jĭ" qq["庚"]= "gēng" qq["辛"]= "xīn" qq["壬"]= "rén" qq["癸"]= "gŭi" qq["子"]= "zĭ" qq["丑"]= "chŏu" qq["寅"]= "yín" qq["卯"]= "măo" qq["辰"]= "chén" qq["巳"]= "sì" qq["午"]= "wŭ" qq["未"]= "wèi" qq["申"]= "shēn" qq["酉"]= "yŏu" qq["戌"]= "xū" qq["亥"]= "hài" GraphicsWindow.BackgroundColor="teal GraphicsWindow.BrushColor="lime GraphicsWindow.FontSize=15 GraphicsWindow.FontBold="false cel = "甲;乙;���;丁;戊;己;庚;辛;壬;癸" ter = "子;丑;寅;卯;辰;巳;午;未;申;酉;戌;亥" ani = "Rat;Ox;Tiger;Rabbit;Dragon;Snake;Horse;Goat;Monkey;Rooster;Dog;Pig" elm = "Wood;Fire;Earth;Metal;Water" asp = "yang;yin" cc=LDText.Split(cel,";") tt=LDText.Split(ter,";") aa=LDText.Split(ani,";") ee=LDText.Split(elm,";") ss=LDText.Split(asp,";") nn=Text.GetCharacter(10) For f=1 To 10 tx=tx+cc[f]+" "+qq[cc[f]]+nn EndFor For f=1 To 12 tx=tx+tt[f]+" "+qq[tt[f]]+nn EndFor GraphicsWindow.DrawBoundText(10 10 200 tx) args=0 LDCall.Function2("kin" 2017 10) LDCall.Function2("kin" 2018 140) LDCall.Function2("kin" 2019 270) Sub kin n=args[1] cycle_year=n-4 stem_number = math.Remainder( cycle_year 10)+1 element_number = math.Round(stem_number/2) branch_number = math.Remainder( cycle_year 12)+1 aspect_number = math.Remainder( cycle_year 2)+1 index = math.Remainder( cycle_year 60)+1 txx="" txx="year: "+n+" | "+index+nn+nn txx=txx+"sign: "+aa[branch_number]+" | "+ee[element_number]+nn+nn txx=txx+" "+cc[stem_number]+tt[branch_number]+" "+qq[cc[stem_number]]+"-"+qq[tt[branch_number]]+":"+ss[aspect_number]+nn GraphicsWindow.FontName="lucida console GraphicsWindow.DrawBoundText(90 args[2] 400 txx) EndSub End>QSP485.sb< Start>QSS694.sb< 'Move Ball & Mouse pointer in tandom with Trailing Shadow fps = 80 ballRadius = 20 numberOfBalls = 20 For i = numberOfBalls To 1 Step -1 'Z-Order ball[i] = Shapes.AddEllipse(ballRadius *2, ballRadius *2) Shapes.SetOpacity(ball[i], 100 - (i-1) * (100/numberOfBalls)) EndFor While 0=0 For i = numberOfBalls To 2 Step -1 'Update Trailing Shadow ballX[i] = ballX[i-1] ballY[i] = ballY[i-1] EndFor ballX[1] = GraphicsWindow.MouseX - ballRadius ballY[1] = GraphicsWindow.MouseY - ballRadius For i = 1 To numberOfBalls Shapes.Move(ball[i],ballX[i] ,ballY[i]) EndFor Program.Delay(Math.Max(0, (1000/fps) - (Clock.ElapsedMilliseconds - start))) start = Clock.ElapsedMilliseconds EndWhile End>QSS694.sb< Start>QSS786.sb< GraphicsWindow.BackgroundColor="darkblue" dw=desktop.Width dh=desktop.Height GraphicsWindow.PenWidth=0 GraphicsWindow.width=240*3 GraphicsWindow.Height=240*3 GraphicsWindow.Top=20 GraphicsWindow.Left=300 GraphicsWindow.Title="Serpinski carpets" size=240 cl=ldtext.Split("cyan gold lime" " ") rt=ldtext.Split("90 180 0" " ") While "true" md=math.GetRandomNumber (3) For nn=0 To 2 For mm=0 To 2 If md=1 then rr=ldshapes.AddStar(6 size/5 size/2) ElseIf md=2 then rr=shapes.AddTriangle(0 0 size 0 size/2 size) Else rr=Shapes.AddRectangle (size*.7,size*.7) endif LDShapes.BrushColour (rr "red") If Math.Remainder(ff 2)=1 then Shapes.Rotate (rr rt[Md]) LDShapes.BrushColour (rr "gold") EndIf ff=ff+1 Shapes.Move(rr 1+nn*size,1+mm*size) If nn*mm=1 then LDShapes.BrushColour (rr Cl[md]) If md=3 then Shapes.Rotate (rr 45) endif EndIf EndFor EndFor Program.Delay(1000) hh=2 If md>=2 Then hh=3 endif for h=1 To hh image = LDGraphicsWindow.Capture("",0) GraphicsWindow.Clear () For n=0 To 2 For m=0 To 2 If n=1 And m=1 then else GraphicsWindow.DrawResizedImage(image,n*size,m*size,240,240) EndIf EndFor EndFor Program.Delay(1000) EndFor Program.Delay (3000) GraphicsWindow.Clear () endwhile End>QSS786.sb< Start>QST393.sb< ' mahreen miangul ApRil 2017 ' Sprite S-W-A-T-F SpaceBar ' Cannon Move XZ Fire F GraphicsWindow.top=0 GraphicsWindow.left=0 GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Width = "1288" GraphicsWindow.Height = "666" GraphicsWindow.BackgroundColor="skyblue" GraphicsWindow.KeyDown = onkeyDown cannon1_x = 644 cannon1_y = 566 sprite1_x = 0 sprite1_y = 20 cannon = Shapes.AddRectangle(50,100) Shapes.Move(cannon, cannon1_x, cannon1_y) GraphicsWindow.BrushColor="darkslategray" Ball=Shapes.AddEllipse(40,40) Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) Shapes.HideShape(Ball) Timer.interval=500 Timer.tick=OnTimerTick '----------------- Draw Hill, Lake, Sun,Cloud-------------------------------------------------------------------------------------------------------- ' Hill GraphicsWindow.brushColor = "tan" GraphicsWindow.fillEllipse(-88,505,620,288) GraphicsWindow.fillEllipse(211,388,622,366) GraphicsWindow.fillEllipse(211,388,1888,666) ' Lake GraphicsWindow.BrushColor = "SkyBlue" GraphicsWindow.PenColor = "LightSlateGray" SnowGlobe = Shapes.AddEllipse(600,200) Shapes.Move(SnowGlobe,666,420) ' Sun GraphicsWindow.BrushColor = "yellow" GraphicsWindow.fillEllipse(1100,10,150,150) GraphicsWindow.BrushColor = "darkslategray" GraphicsWindow.FillEllipse(1130,40,15,45) GraphicsWindow.FillEllipse(1190,40,15,45) GraphicsWindow.penColor = "darkslategray" GraphicsWindow.penwidth = 11 GraphicsWindow.drawline(1140,120,1200,110) ' Clouds GraphicsWindow.PenColor = "darkslategray" GraphicsWindow.PenWidth = 6 GraphicsWindow.DrawEllipse(80,40,100,100) GraphicsWindow.DrawEllipse(50,60,40,50) GraphicsWindow.DrawEllipse(60,16,70,50) GraphicsWindow.DrawEllipse(130,14,70,40) GraphicsWindow.DrawEllipse(150,50,80,50) GraphicsWindow.DrawEllipse(150,90,70,70) GraphicsWindow.DrawEllipse(70,100,95,70) GraphicsWindow.brushColor = "lightgray" GraphicsWindow.fillEllipse(80,40,100,100) GraphicsWindow.fillEllipse(50,60,40,50) GraphicsWindow.fillEllipse(60,16,70,50) GraphicsWindow.fillEllipse(130,14,70,40) GraphicsWindow.fillEllipse(150,50,80,50) GraphicsWindow.fillEllipse(150,90,70,70) GraphicsWindow.fillEllipse(70,100,95,70) '--------------------Font Animation ----------------------------------------------------------------------------------------- GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 77 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "lightyellow" ' Text shadow color GraphicsWindow.DrawText(25, 555, "mahreen miangul!") ' Shadow position/text gold= GraphicsWindow.getcolorfromrgb(121,94,40) GraphicsWindow.BrushColor=gold GraphicsWindow.BrushColor = gold ' Text color GraphicsWindow.DrawText(20, 550, "mahreen miangul!") ' Position and text ' ------------------------Add shapes // (1 to 7) Ducks----------------------------------------------------------- sprite_init() ' <--------- all shape data is input here!! For M=1 to 7 ' <--------- you make 5 Cycles ss=s[M] ' <--------- scale 5 data N=1 ' <--------- shapes array index=1 for i=1 To 10 ' <------ max shape number is 10 GraphicsWindow.PenWidth = shape[N][i]["pw"] GraphicsWindow.BrushColor = shape[N][i]["bc"] GraphicsWindow.penColor = shape[N][i]["pc"] If shape[N][i]["func"]="ell" Then shp[N][i] = Shapes.AddEllipse(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss) ElseIf shape[N][i]["func"]="rect" Then shp[N][i] = Shapes.AddRectangle(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss) ElseIf shape[N][i]["func"]="tri" Then shp[N][i] = Shapes.Addtriangle(shape[N][i]["x1"]*ss, shape[N][i]["y1"]*ss,shape[N][i]["x2"]*ss, shape[N][i]["y2"]*ss, shape[N][i]["x3"]*ss, shape[N][i]["y3"]*ss) ElseIf shape[N][i]["func"]="line" Then shp[N][i] = Shapes.Addline(shape[N][i]["x1"]*ss, shape[N][i]["y1"]*ss,shape[N][i]["x2"]*ss, shape[N][i]["y2"]*ss) EndIf Shapes.Animate(shp[N][i], shape[N][i]["x"]*ss+shX[M], shape[N][i]["y"]*ss+shY[M], 500) ' <---- shx[],shY[] M=1 to 5 Shapes.Rotate(shp[N][i], Shape[N][i]["angle"]) EndFor endfor ' >>>>>>>>>>>>>>>>Add shapes // (8) House<<<<<<<<<<<<<<<< For N=1 to 8 ss=s[N] for i=1 To 26 ' <------ max shape number is 47 GraphicsWindow.PenWidth = shape[N][i]["pw"] GraphicsWindow.BrushColor = shape[N][i]["bc"] GraphicsWindow.penColor = shape[N][i]["pc"] If shape[N][i]["func"]="ell" Then shp[N][i] = Shapes.AddEllipse(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss) ElseIf shape[N][i]["func"]="rect" Then shp[N][i] = Shapes.AddRectangle(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss) ElseIf shape[N][i]["func"]="tri" Then shp[N][i] = Shapes.Addtriangle(shape[N][i]["x1"]*ss, shape[N][i]["y1"]*ss,shape[N][i]["x2"]*ss, shape[N][i]["y2"]*ss, shape[N][i]["x3"]*ss, shape[N][i]["y3"]*ss) ElseIf shape[N][i]["func"]="line" Then shp[N][i] = Shapes.Addline(shape[N][i]["x1"]*ss, shape[N][i]["y1"]*ss,shape[N][i]["x2"]*ss, shape[N][i]["y2"]*ss) EndIf Shapes.Animate(shp[N][i], shape[N][i]["x"]*ss+shX[N], shape[N][i]["y"]*ss+shY[N], 500) Shapes.Rotate(shp[N][i], Shape[N][i]["angle"]) EndFor endfor '-----------------------------------------Animation Shape and Cannon------------------------------------------------------------- shape_init() '   Cycle and Tree Shapes data N=0 M=0 shapes_add() '  Cycle Shape N=1 For M=1 to 8   shapes_add()  '  Tree Shape endfor 'Animate Cycle dZ = 0.1 zoom = 1 'ddx=4 'ddy=4 While 0=0   zoom = zoom - dZ   For i = 1 To Array.GetItemCount(shape[0])     If Array.ContainsValue(shape[0][i], "eye") Then       Shapes.Zoom(shp[0][i], 1, zoom)     ElseIf Array.ContainsValue(shape[0][i], "mouth") Then       Shapes.Zoom(shp[0][i], zoom, zoom)     EndIf     shapes.Move(shp[0][i],shapes.GetLeft(shp[0][i])+ddx,shapes.Gettop(shp[0][i])+ddy)   shapes.Move(shp[0][i],shapes.GetLeft(shp[0][i]),shapes.Gettop(shp[0][i])) EndFor   If zoom = 0 Or zoom = 1 Then     dZ = -dZ   EndIf   Program.Delay(100) EndWhile ''''''''''''''''''''''''''' Sub OnTimerTick Timer.Pause() Shapes.HideShape(Ball) Shapes.Move(Ball,cannon1_x+5,cannon1_y+30) EndSub ' Keys S, W, A, T, X,Z,F , SpaceBar works Sub OnKeyDown key= GraphicsWindow.LastKey If key="S" Then ddx=4 ElseIf Key="W"then ddx=-4 ElseIf Key="A"then ddy=4 ElseIf key="T"Then ddy=-4 ElseIf key="Space" Then ddx=0 'WhT ddy=0 EndIf If Key = "X" Then Shapes.Rotate(cannon,angle+5) angle=angle+5 ElseIf Key = "Z" Then Shapes.Rotate(cannon,angle-5) angle=angle-5 ElseIf Key="F" then Shapes.Animate(ball,GraphicsWindow.width/2,sprite1_y-60,600) Shapes.ShowShape(Ball) Timer.Resume() EndIf EndSub '--------------------------------------------Add Shapes-------------------------------------------------------------------------------------- Sub shapes_add   ss=s[M]    '  <--------- scale  data   for i=1 To Array.GetItemCount(shape[N])      GraphicsWindow.PenWidth = shape[N][i]["pw"]     GraphicsWindow.BrushColor = shape[N][i]["bc"]     GraphicsWindow.penColor = shape[N][i]["pc"]     If shape[N][i]["func"]="ell" Then       shp[M][i] = Shapes.AddEllipse(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss)     ElseIf shape[N][i]["func"]="rect" Then       shp[M][i] = Shapes.AddRectangle(shape[N][i]["width"]*ss, shape[N][i]["height"]*ss)     ElseIf shape[N][i]["func"]="tri" Then       shp[M][i] = Shapes.Addtriangle(shape[N][i]["x1"]*ss, shape[N][i]["y1"]*ss,shape[N][i]["x2"]*ss, shape[N][i]["y2"]*ss, shape[N][i]["x3"]*ss, shape[N][i]["y3"]*ss)     EndIf     Shapes.Animate(shp[M][i], shape[N][i]["x"]*ss+shX[M], shape[N][i]["y"]*ss+shY[M], 500)   EndFor EndSub '-----------------------------------------------------Data Shapes------------------------------------------------------------- Sub shape_init   ' Data Cycle ' Table key: W = width; H = height; X = X rel to the body; Y = Y rel to body; R = rotate angle" shape[0][1] = "func=ell;x=520;y=90;width=30;height=20;bc=bisque;tag=ear"'left   shape[0][2] = "func=ell;x=520;y=150;width=30;height=20;bc=bisque;tag=ear"'right shape[0][3] = "func=ell;x=500;y=95;width=70;height=70;bc=purple;pc=darkslategray;pW=2" 'face shape[0][4] = "func=ell;x=520;y=120;width=30;height=10;bc=sienna;tag=nose" shape[0][5] = "func=ell;x=510;y=115;width=10;height=30;bc=pink;tag=mouth" shape[0][6] = "func=ell;x=530;y=102;width=30;height=20;bc=cyan;pc=darkslategray;pW=2;tag=eye"'eye1 shape[0][7] = "func=ell;x=530;y=128;width=30;height=20;bc=cyan;pc=darkslategray;pW=2;tag=eye"'eye2 shape[0][8] = "func=rect;x=440;y=115;width=50;height=8;bc=green;tag=mouth"'hand1 shape[0][9] = "func=rect;x=440;y=140;width=50;height=8;bc=green;tag=mouth"'hand2 shape[0][10] = "func=rect;x=355;y=120;width=60;height=6;bc=sienna;tag=mouth"'leg1 shape[0][11] = "func=rect;x=355;y=138;width=60;height=6;bc=sienna;tag=mouth"'leg2 shape[0][12] = "func=rect;x=400;y=120;width=100;height=22;bc=darkgoldenrod;pc=darkslategray;pW=2"'body shape[0][13] = "func=tri;x1=566;y1=100;x2=611;y2=130;x3=566;y3=160;bc=gold;angle=0;pw=2;tag=head" '  Data Tree   shape[1][1]="func=ell;X=0;Y=188;width=200;height=140;bc=Green;pc=Green;pw=2"   shape[1][2]="func=ell;X=10;Y=277;width=80;height=60;bc=Green;pc=Green;pw=2   shape[1][3]="func=ell;X=4;Y=255;width=80;height=70;bc=Green;pc=Green;pw=2   shape[1][4]="func=ell;X=0;Y=191;width=80;height=80;bc=Green;pc=Green;pw=2   shape[1][5]="func=ell;X=40;Y=177;width=80;height=80;bc=Green;pc=Green;pw=2   shape[1][6]="func=ell;X=100;Y=177;width=120;height=80;bc=Green;pc=Green;pw=2   shape[1][7]="func=ell;X=130;Y=240;width=100;height=80;bc=Green;pc=Green;pw=2   shape[1][8]="func=ell;X=130;Y=260;width=100;height=80;bc=Green;pc=Green;pw=2   shape[1][9]="func=rect;X=80;Y=322;width=60;height=100;bc=saddlebrown;pc=darkslatgray;pw=2   shape[1][10]="func=tri;X1=140;Y1=262;X2=110;Y2=322;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0   shape[1][11]="func=tri;X1=140;Y1=262;X2=170;Y2=262;X3=140;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0   shape[1][12]="func=tri;X1=50;Y1=262;X2=96;Y2=262;X3=80;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0   shape[1][13]="func=tri;X1=96;Y1=262;X2=80;Y2=322;X3=126;Y3=322;bc=saddlebrown;pc=darkslatgray;pw=0   '  scale and   start XY position   s   = "0=1.1;1=0.8;2=0.8;3=0.8;4=0.8;5=0.8;6=0.8;7=0.8;8=0.8"   shX = "0=0;1=10;2=60;3=122;4=144;5=955;6=1100;7=766;8=666"   shY = "0=0;1=188;2=180;3=177;4=177;5=80;6=110;7=80;8=100" endsub Sub sprite_init ' Duck Data ' duck 1 s[1] = .1 shX[1] = 777 shY[1] = 500 shape[1][1] = "func=tri;x=153;y=41;x1=47;y1=0;x2=0;y2=22;x3=95;y3=22;bc=red;pw=0;beck" shape[1][2] = "func=ell;x=118;y=0;width=91;height=73;bc=blue;pw=0;" shape[1][3] = "func=line;x=172;y=36;x1=0;y1=0;x2=22;y2=0;pc=red;pw=2;blink" shape[1][4] = "func=ell;x=172;y=25;width=22;height=22;bc=pink;pw=0;eye" shape[1][5] = "func=tri;x=132;y=58;x1=31;y1=0;x2=0;y2=45;x3=62;y3=45;bc=red;pw=0;neck" shape[1][6] = "func=tri;x=0;y=80;x1=37;y1=0;x2=0;y2=32;x3=75;y3=32;angle=178;bc=red;pw=0;tail" shape[1][7] = "func=line;x=91;y=134;x1=0;y1=0;x2=0;y2=36;pc=red;pw=8;Leg1" shape[1][8] = "func=ell;x=33;y=72;width=164;height=82;bc=yellow;pw=0;body" shape[1][9] = "func=tri;x=58;y=180;x1=46;y1=0;x2=0;y2=14;x3=93;y3=14;bc=red;pw=0;Leg3" shape[1][10] = "func=line;x=90;y=169;x1=0;y1=0;x2=14;y2=15;pc=yellow;pw=8;Leg2" s[2]=.16 shX[2] = 822 shY[2] = 500 'duck 3 s[3]=.2 shX[3] = 788 shY[3] = 500 'duck 4 s[4]=.28 shX[4] = 822 shY[4] = 500 'duck 5 s[5]=.3 shX[5] = 866 shY[5] = 500 'uck 6 s[6]=.32 shX[6] = 922 shY[6] = 500 ' duck 7 s[7]=.32 shX[7] = 922 shY[7] = 522 s[8] = .5 ' House Data shX[8] = 88 shY[8] = 55 shape[8][1] = "func=rect;x=800;y=280;width=210;height=30;bc=gray;pc=darkslategray;pw=2"'Rec A4 shape[8][2] = "func=rect;x=777;y=310;width=258;height=30;bc=silver;pc=darkslategray;pw=2"'Rec A3 shape[8][3] = "func=rect;x=755;y=340;width=277;height=30;bc=gray;pc=darkslategray;pw=2"'Rec A2 shape[8][4] = "func=rect;x=766;y=370;width=272;height=30;bc=silver;pc=darkslategray;pw=2"'Rec A1 shape[8][5] = "func=tri;x=480;y=340;x1=222;y1=60;x2=262;y2=8;x3=320;y3=60;bc=silver;pc=darkslategray;pw=2"'Tri A1 shape[8][6] = "func=tri;x=480;y=320;x1=244;y1=50;x2=280;y2=6;x3=320;y3=50;bc=gray;pc=darkslategray;pw=2"'Tri A2 shape[8][7] = "func=tri;x=480;y=300;x1=267;y1=40;x2=298;y2=4;x3=320;y3=40;bc=silver;pc=darkslategray;pw=2"'Tri A3 shape[8][8] = "func=tri;x=480;y=280;x1=292;y1=30;x2=320;y2=2;x3=320;y3=30;bc=gray;pc=darkslategray;pw=2"'Tri A4 shape[8][9] = "func=tri;x=480;y=340;x1=530;y1=60;x2=585;y2=8;x3=636;y3=60;bc=silver;pc=darkslategray;pw=2"'Tri A1 shape[8][10] = "func=tri;x=480;y=320;x1=530;y1=50;x2=566;y2=6;x3=608;y3=50;bc=gray;pc=darkslategray;pw=2"'Tri A2 shape[8][11] = "func=tri;x=480;y=300;x1=530;y1=40;x2=548;y2=4;x3=580;y3=40;bc=silver;pc=darkslategray;pw=2"'Tri A3 shape[8][12] = "func=tri;x=480;y=280;x1=530;y1=30;x2=530;y2=2;x3=555;y3=30;bc=gray;pc=darkslategray;pw=2"'Tri A4 shape[8][13] = "func=rect;x=743;y=397;width=333;height=333;bc=snow;pc=darkslategray;pw=2"'Body Structpw=2ure shape[8][14] = "func=rect;x=766;y=608;width=100;height=122;bc=saddlebrown;pc=darkslategray;pw=2"'DoorA shape[8][15] = "func=ell;x=766;y=573;width=100;height=80;bc=saddlebrown;pw=2"'pc=saddlebrown;"'DoorB shape[8][16] ="func=ell;x=788;y=684;width=10;height=10;bc=yellow;pc=darcksategray;pw=2"'DoorC shape[8][17] ="func=rect;x=944;y=480;width=100;height=122;bc=saddlebrown;darkslategray;pw=2"'WindowA shape[8][18] ="func=ell;x=944;y=428;width=100;height=122;bc=saddlebrown;darkslategray;pw=2"'WindowB shape[8][19] = "func=rect;x=955;y=473;width=80;height=111;bc=skyblue;pc=darkslategray;pw=2"'windowC shape[8][20] = "func=ell;x=955;y=442;width=80;height=88;bc=skyblue;pc=darkslategray;pw=2"'windowD shape[8][21] ="func=line;x=877;y=451;x1=80;y1=30;x2=155;y2=30;bc=dodgerblue;pc=darkslategray;pw=2"'Widow Grill 1 shape[8][22] ="func=line;x=8977;y=451;x1=80;y1=60;x2=155;y2=60;bc=dodgerblue;pc=darkslategray;pw=2"'Widow Grill 2 shape[8][23] ="func=line;x=877;y=451;x1=80;y1=90;x2=155;y2=90;bc=dodgerblue;pc=darkslategray;pw=2"'Widow Grill 3 shape[8][24] ="func=line;x=900;y=395;x1=95;y1=44;x2=95;y2=188;bc=dodgerblue;pc=darkslategray;pw=2"'Window Grill 4 shape[8][25] ="func=rect;x=922;y=242;width=80;height=100;bc=crimson;pc=darkslategray;pw=2"'Chimny 1 shape[8][26] ="func=rect;x=911;y=241;width=100;height=20;bc=firebrick;pe;fi=False;x=340;y=72;width=200;height=113;pw=0;bc=#80FFFFFF;name=TextBox 2;" endsub ' Apple s[9] = 0.4 shX[9] = 88 shY[9] = 288 apple[9][1] = "func=rect;x=626;y=110;width=20;height=60;angle=0;bc=green;pw=0;" apple[9][2] = "func=ell;x=511;y=148;width=150;height=150;bc=crimson;pw=0;" apple[9][3] = "func=ell;x=603;y=148;width=150;height=150;bc=crimson;pw=0;" apple[9][4] = "func=ell;x=594;y=188;width=40;height=40;bc=snow;pw=0;" apple[9][5] = "func=ell;x=633;y=188;width=40;height=40;bc=snow;pw=0;" appl3[9][6] = "func=ell;x=614;y=196;width=15;height=15;bc=darkslategray;pw=0;" apple[9][7] = "func=ell;x=635;y=196;width=15;height=15;angle=7;bc=darkslategray;pw=0;" apple[9][8] = "func=rect;x=600;y=250;width=80;height=20;angle=-5;bc=purple;pw=0;" End>QST393.sb< Start>QSV557.sb< start: i = i + 1 pushpopwrite() Goto start Sub pushpopwrite TextWindow.Write("To write in stack: ") push = TextWindow.Read() Stack.PushValue("stackable", push) pop = Stack.PopValue("stackable") TextWindow.WriteLine("Popped from stack: " + pop) Stack.PushValue("stackable", push) ' The following line could be harmful and has been automatically commented. ' File.WriteLine("C:\stackable.txt", i , Stack.PopValue("stackable")) EndSub End>QSV557.sb< Start>QSV762.sb< Game_Width = 600 Game_Height = 600 GraphicsWindow.Width = Game_Width GraphicsWindow.Height = Game_Height Spring = Shapes.AddRectangle(20,100) Spring_X = 200 Spring_Y = 50 Shapes.Move(Spring,Spring_X,Spring_Y) Axis = Shapes.AddEllipse(20,20) Axis_X = 300 Axis_Y = 300 Shapes.Move(Axis,Axis_X-10,Axis_Y-10) While "True" Spring_Distance_To_Axis = math.SquareRoot((Axis_X-Spring_X)*(Axis_X-Spring_X)+(Axis_Y-Spring_Y)*(Axis_Y-Spring_Y)) Spring_Speed = (Spring_Speed*0.8)-(200 - Spring_Distance_To_Axis)*0.2 u = Axis_X-Spring_X v = Axis_Y-Spring_Y If u = 0 Then theta = Math.Pi/2 Else theta = Math.ArcTan(v/u) EndIf If (u < 0) Then theta = Math.Pi+theta EndIf Spring_X = Spring_X + Spring_Speed*Math.Cos(theta) Spring_Y = Spring_Y + Spring_Speed*Math.Sin(theta) If Mouse.IsLeftButtonDown Then Spring_Speed = -50 endif If Mouse.IsRightButtonDown Then Spring_X = GraphicsWindow.MouseX Spring_Y = GraphicsWindow.MouseY endif 'Shapes.Rotate(Spring,Spring_Angle) Shapes.Move(Spring, Spring_X-10, Spring_Y-50) Program.Delay(25) endwhile End>QSV762.sb< Start>QSV888.sb< ' mahreen miangul NovEMber ' Snow Man Moving Left Right GraphicsWindow.Left = 0.1 * (Desktop.Width - GraphicsWindow.Width) GraphicsWindow.Top = 0 * (Desktop.Height - GraphicsWindow.Height) GraphicsWindow.Title = "mahreen miangul" GraphicsWindow.Title = "Snow Man" GraphicsWindow.BackgroundColor = "darkcyan" SB_Workaround() gw = 1111 gh = 700 GraphicsWindow.Width = gw GraphicsWindow.Height = gh ' initialize shapes Shapes_Init() ' add shapes scale = 0.85 angle = 0 iMin = 1 iMax = 93 Shapes_Add() cx = 260 cy = -20 h = 350 a = 20 _a = Math.GetRadians(a) w2 = h * 2 * Math.Sin(_a) w1 = 30 * Math.Sin(_a) For i = 1 To 2 pole[i] = Shapes.AddLine((i - 1.5) * w1, 0, (i - 1.5) * w2, h - 15) Shapes.Move(pole[i], shX + cx, shY + cy + 15) EndFor y = shY + cy + h - 5 While "True" angle = 10 * Math.Sin(_a) Shapes_Rotate() _a = _a + 0.1 Program.Delay(100) EndWhile Sub Shapes_Init ' Shapes | Initialize shapes data ' return shX, shY - current position of shapes ' return shape - array of shapes shX = 52 ' x offset shY = 78 ' y offset shape = "" shape[1] = "func=ell;x=550;y=420;width=300;height=240;bc=darkcyan;pc=#000000;pw=2;" shape[2] = "func=ell;x=620;y=350;width=150;height=100;bc=darkcyan;pc=#000000;pw=2;" shape[3] = "func=ell;x=635;y=400;width=120;height=60;bc=darkcyan;" shape[4] = "func=ell;x=640;y=288;width=100;height=80;bc=darkcyan;pc=#000000;pw=2;" shape[5] = "func=ell;x=655;y=333;width=75;height=30;bc=darkcyan;" shape[6] = "func=ell;x=670;y=300;width=15;height=20;bc=black;" shape[7] = "func=ell;x=700;y=300;width=15;height=20;bc=black;" shape[8] = "func=ell;x=655;y=335;width=70;height=20;bc=darkcyan;pc=black;pw=2;" shape[9] = "func=ell;x=655;y=330;width=80;height=12;bc=darkcyan;" shape[10] = "func=rect;x=680;y=325;width=40;height=3;angle=-2;bc=black;pw=2;" shape[11] = "func=rect;x=680;y=330;width=40;height=3;angle=-16;bc=black;pw=2;" shape[12] = "func=rect;x=490;y=340;width=150;height=3;angle=25;bc=black;pw=2;" shape[13] = "func=rect;x=480;y=325;width=40;height=3;angle=-20;bc=black;pw=2;" shape[14] = "func=rect;x=510;y=305;width=40;height=3;angle=-100;bc=black;pw=2;" shape[15] = "func=rect;x=745;y=340;width=150;height=3;angle=-20;bc=black;pw=2;" shape[16] = "func=rect;x=870;y=330;width=40;height=3;angle=20;bc=black;pw=2;" shape[17] = "func=rect;x=840;y=305;width=40;height=3;angle=90;bc=black;pw=2;" shape[18] = "func=rect;x=625;y=290;width=120;height=3;angle=-10;bc=black;pw=2;" shape[19] = "func=rect;x=605;y=270;width=150;height=3;angle=-10;bc=black;pw=2;" shape[20] = "func=rect;x=605;y=292;width=27;height=3;angle=40;bc=black;pw=2;" shape[21] = "func=rect;x=733;y=270;width=27;height=3;angle=-65;bc=black;pw=2;" shape[22] = "func=rect;x=590;y=240;width=80;height=3;angle=90;bc=black;pw=2;" shape[23] = "func=rect;x=680;y=222;width=80;height=3;angle=70;bc=black;pw=2;" shape[24] = "func=rect;x=626;y=192;width=80;height=3;angle=-10;bc=black;pw=2;" shape[25] = "func=rect;x=645;y=281;width=70;height=10;angle=-10;bc=darkcyan;pw=0;" EndSub Sub Math_CartesianToPolar ' Math | convert cartesian coodinate to polar coordinate ' param x, y - cartesian coordinate ' return r, a - polar coordinate r = Math.SquareRoot(x * x + y * y) If x = 0 And y > 0 Then a = 90 ' [degree] ElseIf x = 0 And y < 0 Then a = -90 ElseIf x = 0 Then a = 0 Else a = Math.ArcTan(y / x) * 180 / Math.Pi EndIf If x < 0 Then a = a + 180 ElseIf x > 0 And y < 0 Then a = a + 360 EndIf EndSub Sub SB_RotateWorkaround ' Small Basic | Rotate workaround for Silverlight ' param shp - current shape ' param x, y - original coordinate ' param alpha - angle [radian] ' returns x, y - workaround coordinate If shp["func"] = "tri" Then x1 = -Math.Floor(shp["x3"] / 2) y1 = -Math.Floor(shp["y3"] / 2) ElseIf shp["func"] = "line" Then x1 = -Math.Floor(Math.Abs(shp["x1"] - shp["x2"]) / 2) y1 = -Math.Floor(Math.Abs(shp["y1"] - shp["y2"]) / 2) EndIf ox = x - x1 oy = y - y1 x = x1 * Math.Cos(alpha) - y1 * Math.Sin(alpha) + ox y = x1 * Math.Sin(alpha) + y1 * Math.Cos(alpha) + oy EndSub Sub SB_Workaround ' Small Basic | Workaround for Silverlight ' returns silverlight - "True" if in remote color = GraphicsWindow.GetPixel(0, 0) If Text.GetLength(color) > 7 Then silverlight = "True" msWait = 300 Else silverlight = "False" EndIf EndSub Sub Shapes_Add ' Shapes | add shapes as shapes data ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - 1 if same scale ' return shWidth, shHeight - total size of shapes ' return shAngle - current angle of shapes Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) Shapes_CalcWidthAndHeight() s = scale For i = iMin To iMax shp = shape[i] GraphicsWindow.PenWidth = shp["pw"] * s If shp["pw"] > 0 Then GraphicsWindow.PenColor = shp["pc"] EndIf If Text.IsSubText("rect|ell|tri|text", shp["func"]) Then GraphicsWindow.BrushColor = shp["bc"] EndIf If shp["func"] = "rect" Then shp["obj"] = Shapes.AddRectangle(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "ell" Then shp["obj"] = Shapes.AddEllipse(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "tri" Then shp["obj"] = Shapes.AddTriangle(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s, shp["x3"] * s, shp["y3"] * s) ElseIf shp["func"] = "line" Then shp["obj"] = Shapes.AddLine(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s) ElseIf shp["func"] = "text" Then If silverlight Then fs = Math.Floor(shp["fs"] * 0.9) Else fs = shp["fs"] EndIf GraphicsWindow.FontSize = fs * s GraphicsWindow.FontName = shp["fn"] shp["obj"] = Shapes.AddText(shp["text"]) EndIf x = shp["x"] y = shp["y"] shp["rx"] = x shp["ry"] = y If silverlight And Text.IsSubText("tri|line", shp["func"]) Then alpha = Math.GetRadians(shp["angle"]) SB_RotateWorkaround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], shX + x * s, shY + y * s) If Text.IsSubText("rect|ell|tri|text", shp["func"]) And (shp["angle"] <> 0) And (shp["angle"] <> "") Then Shapes.Rotate(shp["obj"], shp["angle"]) EndIf shape[i] = shp EndFor shAngle = 0 y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub Sub Shapes_CalcRotatePos ' Shapes | Calculate position for rotated shape ' param["x"], param["y"] - position of a shape ' param["width"], param["height"] - size of a shape ' param ["cx"], param["cy"] - center of rotation ' param ["angle"] - rotate angle ' return x, y - rotated position of a shape _cx = param["x"] + param["width"] / 2 _cy = param["y"] + param["height"] / 2 x = _cx - param["cx"] y = _cy - param["cy"] Math_CartesianToPolar() a = a + param["angle"] x = r * Math.Cos(a * Math.Pi / 180) y = r * Math.Sin(a * Math.Pi / 180) _cx = x + param["cx"] _cy = y + param["cy"] x = _cx - param["width"] / 2 y = _cy - param["height"] / 2 EndSub Sub Shapes_CalcWidthAndHeight ' Shapes | Calculate total width and height of shapes ' param iMin, iMax - shape indices to add ' return shWidth, shHeight - total size of shapes For i = iMin To iMax shp = shape[i] If shp["func"] = "tri" Or shp["func"] = "line" Then xmin = shp["x1"] xmax = shp["x1"] ymin = shp["y1"] ymax = shp["y1"] If shp["x2"] < xmin Then xmin = shp["x2"] EndIf If xmax < shp["x2"] Then xmax = shp["x2"] EndIf If shp["y2"] < ymin Then ymin = shp["y2"] EndIf If ymax < shp["y2"] Then ymax = shp["y2"] EndIf If shp["func"] = "tri" Then If shp["x3"] < xmin Then xmin = shp["x3"] EndIf If xmax < shp["x3"] Then xmax = shp["x3"] EndIf If shp["y3"] < ymin Then ymin = shp["y3"] EndIf If ymax < shp["y3"] Then ymax = shp["y3"] EndIf EndIf shp["width"] = xmax - xmin shp["height"] = ymax - ymin EndIf If i = 1 Then shWidth = shp["x"] + shp["width"] shHeight = shp["y"] + shp["height"] Else If shWidth < shp["x"] + shp["width"] Then shWidth = shp["x"] + shp["width"] EndIf If shHeight < shp["y"] + shp["height"] Then shHeight = shp["y"] + shp["height"] EndIf EndIf shape[i] = shp EndFor EndSub Sub Shapes_Move ' Shapes | Move shapes ' param iMin, iMax - shape indices to add ' param shape - array of shapes ' param scale - to zoom ' param x, y - position to move ' return shX, shY - new position of shapes Stack.PushValue("local", i) s = scale shX = x shY = y For i = iMin To iMax shp = shape[i] If silverlight And Text.IsSubText("tri|line", shp["func"]) Then _x = shp["wx"] _y = shp["wy"] Else _x = shp["rx"] _y = shp["ry"] EndIf Shapes.Move(shp["obj"], shX + _x * s, shY + _y * s) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Remove ' Shapes | Remove shapes ' param iMin, iMax - shapes indices to remove ' param shape - array of shapes Stack.PushValue("local", i) For i = iMin To iMax shp = shape[i] Shapes.Remove(shp["obj"]) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Rotate ' Shapes | Rotate shapes ' param iMin, iMax - shapes indices to rotate ' param shape - array of shapes ' param cx, cy - rotation center ' param scale - to zoom ' param angle - to rotate Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) s = scale param["angle"] = angle If cx <> "" Then param["cx"] = cx Else cx = "" ' to avoid syntax error param["cx"] = shWidth / 2 EndIf If cy <> "" Then param["cy"] = cy Else cy = "" ' to avoid syntax error param["cy"] = shHeight / 2 EndIf For i = iMin To iMax shp = shape[i] param["x"] = shp["x"] param["y"] = shp["y"] param["width"] = shp["width"] param["height"] = shp["height"] Shapes_CalcRotatePos() shp["rx"] = x shp["ry"] = y If silverlight And Text.IsSubText("tri|line", shp["func"]) Then If shp["angle"] = "" Then a = angle Else a = angle + shp["angle"] EndIf alpha = Math.GetRadians(a) SB_RotateWorkAround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], shX + x * s, shY + y * s) If shp["angle"] = "" Then a = angle Else a = angle + shp["angle"] EndIf Shapes.Rotate(shp["obj"], a) shape[i] = shp EndFor y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub End>QSV888.sb< Start>QSW829.sb< GraphicsWindow.Title ="Snails b=2 GraphicsWindow.BackgroundColor="darkblue GraphicsWindow.PenWidth =2 a=1 GraphicsWindow.Width =1600 GraphicsWindow.Height=900 GraphicsWindow.Top =10 GraphicsWindow.Left =10 q7=8.5 For f= 1800 to 0 Step -15 'if Math.Remainder (f 2)=0 Then 'b=b*.9995 r=b*f 'arh.spiral 'r=a*ldmath.cos(k*f) x=r*ldmath.cos(f)/20 y=r*ldmath.sin(f)/20 If f<1800 then hh=math.Remainder (f/q7-30 360) GraphicsWindow.BrushColor =LDColours.HSLtoRGB (hh 1 .6) GraphicsWindow.penColor =GraphicsWindow.BrushColor Shapes.AddTriangle (400 400 x+400,y+400 ox+400 oy+400) EndIf ox=x oy=y EndFor b=2 f800=648 For f= 1800 to 0 Step -15 'if Math.Remainder (f 2)=0 Then ' b=b*.9995 r=b*f 'arh.spiral 'r=a*ldmath.cos(k*f) x=r*ldmath.cos(-f)/20 y=r*ldmath.sin(-f)/20 If f<1800 then hh=math.Remainder (f/q7-30 360) GraphicsWindow.BrushColor =LDColours.HSLtoRGB (hh 1 .6) GraphicsWindow.penColor =GraphicsWindow.BrushColor Shapes.AddTriangle (f800 400 f800-x,y+400 f800-ox oy+400) EndIf ox=x oy=y EndFor aa= LDShapes.GetAllShapes() nn=Array.GetItemCount (aa)/2 while "true for f=0 To -360 Step -10 For r=1 To nn LDShapes.RotateAbout (aa[r] 400 400 f) EndFor For r=1 To nn LDShapes.RotateAbout (aa[r+nn] f800 400, f) EndFor EndFor EndWhile End>QSW829.sb< Start>QSW885.sb< ' A 3-D game starting point ' Uses mouse left-right to roll, up-down to pitch, and left-right buttons for heading (similar to airplane controls) ' References ' http://en.wikipedia.org/wiki/3D_projection ' http://social.msdn.microsoft.com/Forums/en-US/smallbasic/thread/2bfaa80d-91db-4df7-aa2f-413e1e6a9f30 ' Ver 1 4/8/2010 Daddyo false = 0 true = 1 dText = "" ' Debugging output windowWidth = 800 windowHeight = 500 ' Desired approximate frames per second (but will be lower on slower computers) fpsTarget = 20 ' Determine speed of computer CalibrateDelay() ' Set up graphics window GraphicsWindow.BackgroundColor = "DarkGreen" GraphicsWindow.Title = "" GraphicsWindow.Show() GraphicsWindow.Width = windowWidth GraphicsWindow.Height = windowHeight ' Center it on desktop GraphicsWindow.Left = Desktop.Width / 2 - GraphicsWindow.Width / 2 GraphicsWindow.Top = Desktop.Height / 2 - GraphicsWindow.Height / 2 ' Show a dot in center of display for mouse reference when 'steering' camera GraphicsWindow.PenColor = "Yellow" centerShape = Shapes.AddEllipse(4, 4) Shapes.Move(centerShape, windowWidth * 0.5 - 2, windowHeight * 0.5 - 2) InitViewer() InitScenery() ' The game loop MainLoop() ' Exit game Program.End() ' Main game routine Sub MainLoop ' Game control variables (not set in this example) play = true pause = false ' Initialize filter for frame rate estimation dTLossy = 1000 / fpsTarget tLast = Clock.Millisecond ' Loop forever while playing While(play = true) ' Do work if not paused If (pause = false) Then Move() UpdateScreen() ' Smooth estimate of time elapsed between frames tNow = Clock.Millisecond dT = tNow - tLast tLast = tNow ' Handle millisecond rollover at 1 second marks If (dT < 0) Then dT = dT + 1000 EndIf k = 0.1 ' 1 = no smoothing, values less than 1 smooths. 0.1 default dTLossy = dTLossy * (1 - k) + dT * k ' Figure out how long we need to wait to achieve desired average frame rate waitLoops = 1000 / fpsTarget - dTLossy ' Milliseconds of time to kill waitLoops = waitLoops * loopsPerMilliSec For i = 1 to waitLoops i = i EndFor ' Show FPS 'dText = 1000/dTLossy 'Debug() EndIf EndWhile EndSub ' Determine how many For loops we can do in a millisecond, used for calibrated delays Sub CalibrateDelay Program.Delay(200) ' Let software 'settle' on load ' Figure out dummy wait loops per millisecond ' Used instead of Program.Delay()'s coarse resolution of 16 ms tLast = Clock.Millisecond waitLoops = 20000 For i = 1 to waitLoops i = i EndFor tNow = Clock.Millisecond dT = tNow - tLast If (dT < 0) Then dT = dT + 1000 EndIf loopsPerMilliSec = 20000 / dT EndSub ' Do the motion of the camera/plane/tank/person etc. Sub Move ' Determine view attitude from mouse pitch = Math.Pi * (GraphicsWindow.MouseY - windowHeight * 0.5) / windowHeight roll = 2 * Math.Pi * (GraphicsWindow.MouseX - windowWidth * 0.5) / windowWidth ' Heading, if both mouse buttons pressed, reset heading to zero (north) If Mouse.IsLeftButtonDown Then If Mouse.IsRightButtonDown Then heading = 0 Else heading = heading - 0.04 EndIf ElseIf Mouse.IsRightButtonDown Then heading = heading + 0.04 EndIf If heading > 2 * Math.Pi Then heading = 0 ElseIf heading < 0 Then heading = 2 * Math.Pi EndIf ' Move slowly north pY = pY + 0.3 'r2d = 57.29 'TextWindow.WriteLine("H: " + heading * r2d + ", P: " + pitch * r2d + ", R:" + roll * r2d) EndSub ' Update all graphics resulting from motion/view updates Sub UpdateScreen ' Do this once per frame SetCamera() ' Translate all objects to graphics window For i = 1 to objects ' Copy point for input to TransformPoint subroutine x = objX[i] y = objY[i] z = objZ[i] ' Position/rotate point to display surface TransformPoint() ' Note: shouldn't really plot anything outside the graphics window area (<0 or >width or height) ' but not checked here ' Erase old point, only plot if in front of camera (not behind!) If (objZold[i] > 0) Then GraphicsWindow.BrushColor = "DarkGreen" GraphicsWindow.FillEllipse(objXold[i]-3, objYold[i]-3, 6, 6) EndIf ' Draw new point If (z > 0) Then ' Draw special colors for north/east points so we can make sure all's well If i = 27 Then ' north point GraphicsWindow.BrushColor = "White" ElseIf i = 41 Then ' east point GraphicsWindow.BrushColor = "Blue" Else GraphicsWindow.BrushColor = "Red" EndIf GraphicsWindow.FillEllipse(x-2, y-2, 4, 4) EndIf ' Save point for erasure next frame objXold[i] = x objYold[i] = y objZold[i] = z EndFor EndSub ' Initialize our variables Sub InitViewer ' Viewer attitude, Euler order is heading-pitch-roll heading = 0 pitch = 0 roll = 0 ' Viewer position - any linear units you want (meters, feet, angstroms), just keep everything in same units! pX = 0 ' +East pY = -300 ' +North pZ = 60 ' +up EndSub ' Initialize the scenery Sub InitScenery method = 2 ' 1 or 2 for demo If method = 1 Then ' Individually create points on display objects = 4 objX[1] = 30 objY[1] = 150 objZ[1] = 0 objX[2] = 30 objY[2] = -150 objZ[2] = 0 objX[3] = -30 objY[3] = -150 objZ[3] = 0 objX[4] = -30 objY[4] = 150 objZ[4] = 0 ElseIf method = 2 Then ' Draw rectangular grid, ground level, long side runs north-south objects = 0 z = 0 For x = -200 To 200 Step 100 For y = -400 To 400 Step 100 objX[objects+1] = x objY[objects+1] = y objZ[objects+1] = z objects = objects + 1 'TextWindow.WriteLine(objects + ": " + x + ", " + y + ", " + z) EndFor EndFor EndIf EndSub ' Set camera view (done once/frame) ' This would normally speed up processing a group TransformPoint calls, ' but wasn't really measureable in Small Basic Sub SetCamera cosHeading = Math.Cos(heading) sinHeading = Math.Sin(heading) cosPitch = Math.Cos(pitch) sinPitch = Math.Sin(pitch) cosRoll = Math.Cos(roll) sinRoll = Math.Sin(roll) EndSub ' Transform point in space x,y,z to screen coordinates x,y ' Input uses a right-handed coordinate system (+x east, +y north, +z up). ' Positive heading is viewer rotating clockwise when looking down to ground, relative from North. Range: 0 to 2PI (0-360 degrees) ' Positive pitch is viewer 'nose' up. Range: +/- PI/2 (+/- 90 degrees) ' Positive roll is viewer rolled clockwise from vertical as observed from rear cockpit view. Range: +/- PI (-180 to +180 degrees) ' ' modified from http://gamecode.tripod.com/tut/tut03.htm (note bug: z=twice on yaw rotation) Sub TransformPoint ' Shift point in space to point relative to camera position x2 = x - Px y2 = y - Py z2 = z - Pz ' Now do rotations about camera point, Euler order is heading - pitch - roll ' Heading rotation x = -y2 * sinHeading + x2 * cosHeading y = y2 * cosHeading + x2 * sinHeading z = z2 ' Pitch x2 = x y2 = z * sinPitch + y * cosPitch z2 = z * cosPitch - y * sinPitch ' Roll x = -z2 * sinRoll + x2 * cosRoll y = z2 * cosRoll + x2 * sinRoll z = y2 ' Check to see if point is very close to camera, ' if so put it behind the camera (so not shown and doesn't cause divide by zero below) If Math.Abs(z) < .01 Then z = -0.01 EndIf ' Perspective project onto screen & center it in graphics window fov = windowWidth * 0.25 ' relative field of view - adjust 0.25 to what you like x = x * fov / z + windowWidth * 0.5 y = -y * fov / z + windowHeight * 0.5 ' Negate Y since opposite that of the graphics window sense EndSub ' Fill in dText variable and call this to print it on display for debugging code sub Debug ' Erase old printout GraphicsWindow.PenColor = "black" GraphicsWindow.BrushColor = "black" GraphicsWindow.FillRectangle (0, 30, 500, 30) ' Draw new printout GraphicsWindow.BrushColor = "LightCyan" GraphicsWindow.FontSize=20 GraphicsWindow.DrawText(0, 30, dText) EndSub End>QSW885.sb< Start>QTB307.sb< Base = 1 Lower = 2 Higher = 3 Pivot = 4 Sorted = 5 'Create a random 1000 element array numVal = 1000 For i = 1 To numVal val[i] = Math.GetRandomNumber(numVal) EndFor 'ShellSort it quicksort() 'Write the result For i = 1 To numVal TextWindow.WriteLine(i+" : "+val[i]) EndFor Sub quicksort For i = 1 To numVal Stack.PushValue(Base, val[i]) EndFor While (Stack.GetCount(Base) > 0) pivVal = Stack.PopValue(Base) popVal = pivVal Stack.PushValue(Pivot, pivVal) FirstLoop() If (Stack.GetCount(Higher) = 0) Then PushTo = Sorted Else PushTo = Lower EndIf SecondLoop() If (Stack.GetCount(Higher) > 0) Then Temp = Higher Higher = Base Base = Temp ElseIf (Stack.GetCount(Lower) > 0) then Temp = Lower Lower = Base Base = Temp EndIf EndWhile val = "" i = 1 ThirdLoop() Endsub Sub FirstLoop While (Stack.GetCount(Base) > 0) popVal = Stack.PopValue(Base) If (popVal = pivVal) Then Stack.PushValue(Pivot, popVal) ElseIf (popVal > pivVal) then Stack.PushValue(Higher, popVal) Else Stack.PushValue(Lower, popVal) EndIf EndWhile EndSub Sub SecondLoop While (Stack.GetCount(Pivot) > 0) popVal = Stack.PopValue(Pivot) Stack.PushValue(PushTo, popVal) EndWhile EndSub Sub ThirdLoop While (Stack.GetCount(Sorted) > 0) val[i] = Stack.PopValue(Sorted) i = i + 1 EndWhile EndSub End>QTB307.sb< Start>QTF063-0.sb< GraphicsWindow.Show() For i = 1 To 200 GraphicsWindow.FontSize = 10 iFontSize = GraphicsWindow.FontSize If (iFontSize <> 10) Then GraphicsWindow.ShowMessage(iFontSize + " != 10 ","Error") EndIf EndFor End>QTF063-0.sb< Start>QTF063.sb< GraphicsWindow.Show() GraphicsWindow.Height = 640 For i = 1 To 200 GraphicsWindow.FontSize = 10 iFontSize = GraphicsWindow.FontSize If (iFontSize <> 10) Then GraphicsWindow.ShowMessage(iFontSize + " != 10 ","Error") EndIf GraphicsWindow.FontSize = Math.GetRandomNumber(10) + 10 EndFor End>QTF063.sb< Start>QTK092.sb< cc="silver gold black brown red orange yellow green blue violet gray white tt="10 5 x 1 2 x x .5 .25 .1 x x cl=ldtext.Split (cc " ") 'ls= LDList.CreateFromValues (cl) GraphicsWindow.BrushColor ="black rr=Controls.AddTextBox (5 5) bb= Controls.AddButton ("calc" 280 5) kk= ldControls.AddCheckBox ("kohm") Controls.Move (kk 200 5) Controls.SetTextBoxText (rr 100) GraphicsWindow.BackgroundColor ="teal GraphicsWindow.Title="Resistors' color codes Controls.ButtonClicked =bcc For f=1 to 4 cb[f]=LDControls.AddComboBox(cl 200 100) Controls.Move (cb[f] 10 250+f*30) endfor bbd= Controls.AddButton ("decode" 280 280) Sub bcc GraphicsWindow.BrushColor ="#00bbbb GraphicsWindow.FillRectangle (50 150 250 75) If Controls.LastClickedButton=bbd Then 'GraphicsWindow.Title =LDControls.ComboBoxGetSelected (cb[1]) GraphicsWindow.BrushColor=cl[LDControls.ComboBoxGetSelected (cb[1])] GraphicsWindow.FillRectangle (60 150 15 75) GraphicsWindow.BrushColor=cl[LDControls.ComboBoxGetSelected (cb[2])] GraphicsWindow.FillRectangle (90 150 15 75) GraphicsWindow.BrushColor=cl[LDControls.ComboBoxGetSelected (cb[3])] GraphicsWindow.FillRectangle (120 150 15 75) GraphicsWindow.BrushColor=cl[LDControls.ComboBoxGetSelected (cb[4])] GraphicsWindow.FillRectangle (180 150 15 75) v1= LDControls.ComboBoxGetSelected (cb[1])-3 v2= LDControls.ComboBoxGetSelected (cb[2])-3 v3= LDControls.ComboBoxGetSelected (cb[3])-3 v4= LDControls.ComboBoxGetSelected (cb[4]) 'TextWindow .Write (v1+", ") ' TextWindow .Write (v2+", ") ' TextWindow .Writeline (v3) dw=math.Power (10 v3)*((v1*10)+v2) If dw>1000 Then GraphicsWindow.Title ="Resistance:"+ldmath.FixDecimal (dw/1000 1)+" kohm Else GraphicsWindow.Title ="Resistance:"+dw+" ohm EndIf else vv= Controls.GetTextBoxText (rr) If LDControls.CheckBoxGetState(kk) Then vv=vv*1000 EndIf vv=ldmath.FixDecimal (vv 0) GraphicsWindow.Title=vv ll=text.GetLength (vv) mm=ll-2 'GraphicsWindow.Title=mm If mm>=0 then d1=text.GetSubText (vv 1 1) d2=text.GetSubText (vv 2 1) GraphicsWindow.BrushColor=cl[d1+3] GraphicsWindow.FillRectangle (60 150 15 75) GraphicsWindow.BrushColor=cl[d2+3] GraphicsWindow.FillRectangle (90 150 15 75) GraphicsWindow.BrushColor=cl[mm+3] GraphicsWindow.FillRectangle (120 150 15 75) GraphicsWindow.BrushColor="gold GraphicsWindow.FillRectangle (180 150 15 75) EndIf EndIf EndSub End>QTK092.sb< Start>QTN644.sb< GraphicsWindow.BackgroundColor="Black" GraphicsWindow.Height = 600 GraphicsWindow.Width = 800 GraphicsWindow.Show() GraphicsWindow.KeyDown = ReadKey 'Information frame on left GraphicsWindow.BrushColor = "Gainsboro" GraphicsWindow.FillRectangle(0,0,200,600) 'text in Info Frame GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(48,1,"Adventurer's Name") GraphicsWindow.DrawText(48,80,"Map Coordinates:") GraphicsWindow.DrawText(5,220,"Forward = Up Arrow") GraphicsWindow.DrawText(5,240,"Back = Down Arrow") GraphicsWindow.DrawText(5,260,"Strafe left = Left Arrow") GraphicsWindow.DrawText(5,280,"Strafe right = Right Arrow") GraphicsWindow.DrawText(5,320,"Turn left/right = A / D") GraphicsWindow.DrawText(5,340,"End program = Esc") 'draw box around Maze-View window on the right GraphicsWindow.PenColor = "White" GraphicsWindow.PenWidth = 4 GraphicsWindow.DrawRectangle(200,0,600,600) 'Setup object's coordinates z1 = 100 z2 = 100 z3 = 100 z4 = 100 x1 = -10 y1 = 10 x2 = 10 y2 = -10 CameraAngle = 0 cameraX = 0 cameraY = 0 cameraZ1 = 0 cameraZ2 = 0 Main: 'erase walls from Maze-View window GraphicsWindow.BrushColor = "Black" GraphicsWindow.PenWidth = 2 GraphicsWindow.FillRectangle(200,0,600,800) GraphicsWindow.PenColor = "White" 'draw box around Maze-View window on the right GraphicsWindow.PenColor = "White" GraphicsWindow.PenWidth = 4 GraphicsWindow.DrawRectangle(200,0,600,600) 'GraphicsWindow.BrushColor = "White" 'GraphicsWindow.DrawText(0,15*(z-700),z) 'X left_X = (600 * x1 / (z1 + cameraZ1) + 600 / 2) - cameraX right_X = (600 * x2 / (z2 + cameraZ2) + 600 / 2) - cameraX 'end Y topLeft_Y = (600 * y1 / (z1 + cameraZ1) + 600 / 2) - cameraY topRight_Y = (600 * y1 / (z2 + cameraZ2) + 600 / 2) - cameraY bottomRight_Y = (600 * y2 / (z2 + cameraZ1) + 600 / 2) - cameraY bottomLeft_Y = (600 * y2 / (z1 + cameraZ1) + 600 / 2) - cameraY 'camera angle If caChange = "yes" Then x1tmp = left_X * Math.Cos(deltaAngle) - z1 * Math.Sin(deltaAngle) z1tmp = z1 * Math.Cos(deltaAngle) + x1 * Math.Sin(deltaAngle) left_X = x1tmp z1 = z1tmp x2tmp = right_X * Math.Cos(deltaAngle) - z2 * Math.Sin(deltaAngle) z2tmp = z2 * Math.Cos(deltaAngle) + x2 * Math.Sin(deltaAngle) right_X = x2tmp z2 = z2tmp caChange = "no" endif 'Draw maze GraphicsWindow.PenWidth = 2 GraphicsWindow.DrawLine(left_X + 200, topLeft_Y, right_X + 200, topRight_Y) GraphicsWindow.DrawLine(right_X + 200, topRight_Y, right_X + 200, bottomRight_Y) GraphicsWindow.DrawLine(right_X + 200, bottomRight_Y, left_X + 200, bottomLeft_Y) GraphicsWindow.DrawLine(left_X + 200, bottomLeft_Y, left_X + 200, topLeft_Y) TextWindow.WriteLine("") TextWindow.Write("Z1: ") TextWindow.WriteLine(z1) TextWindow.Write("Z2: ") TextWindow.WriteLine(z2) TextWindow.Write("Camera Z1: ") TextWindow.WriteLine(cameraZ1) TextWindow.Write("Camera Z2: ") TextWindow.WriteLine(cameraZ1) TextWindow.Write("B1 L1 X1: ") TextWindow.WriteLine(left_X) TextWindow.Write("B1 L1 X2: ") TextWindow.WriteLine(right_X) TextWindow.Write("B1 L1 Y1: ") TextWindow.WriteLine(topLeft_Y) TextWindow.Write("B1 L1 Y2: ") TextWindow.WriteLine(topRight_Y) TextWindow.Write("Camera X - ") TextWindow.WriteLine(cameraX) TextWindow.Write("Camera Y - ") TextWindow.WriteLine(cameraY) TextWindow.Write("Camera Angle - ") TextWindow.WriteLine(CameraAngle) TextWindow.WriteLine(key) TextWindow.WriteLine("**********") keyisupdated = "False" key = "" While (keyisupdated = "False") EndWhile If key = "Up" Then 'move forward cameraZ1 = cameraZ1 - 10 cameraZ2 = cameraZ2 - 10 'If cameraZ1 > 0 Then ' cameraZ1 = 0 'EndIf 'If cameraZ2 > 0 Then ' cameraZ2 = 0 'EndIf ElseIf key = "Down" Then 'move backward cameraZ1 = cameraZ1 + 10 cameraZ2 = cameraZ2 + 10 ElseIf key = "Left" Then 'strafe left cameraX = cameraX - 5 ElseIf key = "Right" Then 'strafe right cameraX = cameraX + 5 ElseIf key = "A" Then 'turn left deltaAngle = .05 CameraAngle = CameraAngle + deltaAngle caChange = "yes" ElseIf key = "D" Then 'turn right deltaAngle = -0.05 CameraAngle = CameraAngle + deltaAngle caChange = "yes" EndIf If key = "Escape" Then Program.End() EndIf Goto Main Sub ReadKey key = GraphicsWindow.LastKey keyisupdated = "True" EndSub End>QTN644.sb< Start>QTN895.sb< 'EXFS Exospheric Freight Service 'PROGRAM BY cvmarus 'Graphic Images for this program are downloaded from my gallery at imgbox.com when this program runs LDGraphicsWindow.State = 2 var() GraphicsWindow.BackgroundColor="Black" missionbriefing() 'VIEW PORTS view3d = LD3DView.AddView(gw,gh,"False") ''display view space = LD3DView.AddView(10,10,"False") ''view for collision detection LDGraphicsWindow.PauseUpdates() LDEvents.MouseDoubleClick = onmousedoubleclick LDEvents.MouseWheel = onmousewheel GraphicsWindow.MouseMove = onmousemove GraphicsWindow.KeyDown = onkey GraphicsWindow.KeyUp = upkey GraphicsWindow.MouseDown = onmousedown LDControls.RadioButtonClicked = onradioclick LD3DView.RotationCompleted = onanimaterotatecomplete Controls.ButtonClicked = onbuttonclick 'TIMERS Timer.Tick = ontimer Timer.Interval = 15 Timer.Pause() LDTimer.Tick = onldtimer ldticker = LDTimer.Add() onstarttimer = LDTimer.Add() LDTimer.Interval(onstarttimer,30) LDTimer.Pause(onstarttimer) onbumptimer = LDTimer.Add() LDTimer.Interval(onbumptimer,400) LDTimer.Pause(onbumptimer) onbeamtimer = LDTimer.Add() LDTimer.Interval(onbeamtimer,45) LDTimer.Pause(onbeamtimer) thrusttimer = LDTimer.Add() LDTimer.Interval(thrusttimer,1000) LDTimer.Pause(thrusttimer) tryhack = LDTimer.AddTick(ldticker) LDTimer.Interval(tryhack,200) LDTimer.Pause(tryhack) syncrotime = LDTimer.AddTick(ldticker) LDTimer.Interval(syncrotime,15000) LDTimer.Pause(syncrotime) forcefieldtime = LDTimer.AddTick(ldticker) LDTimer.Interval(forcefieldtime,200) LDTimer.Pause(forcefieldtime) checkproximity = LDTimer.AddTick(ldticker) LDTimer.Interval(checkproximity,500) LDTimer.Pause(checkproximity) tryconnecttime = LDTimer.AddTick(ldticker) LDTimer.Interval(tryconnecttime,400) LDTimer.Pause(tryconnecttime) endgametime = LDTimer.AddTick(ldticker) LDTimer.Interval(endgametime,12000) LDTimer.Pause(endgametime) msgtimer = LDTimer.AddTick(ldticker) LDTimer.Interval(msgtimer,15000) LDTimer.Pause(msgtimer) 'GLOBE MODEL globe = LD3DView.AddSphere(view3d,12500,64,"Black","S") globe1 = LD3DView.AddSphere(space,12500,64,tint,"E") LD3DView.AddImage(view3d,globe,"","https://www.ngdc.noaa.gov/mgg/image/color_etopo1_ice_low.jpg","D") LD3DView.TranslateGeometry(view3d,globe,10000,10000,10000) LD3DView.TranslateGeometry(space,globe1,10000,10000,10000) LD3DView.RotateGeometry3(view3d,globe,.25,.05,-.25,90) LD3DView.AnimateRotation(view3d,globe,0,0,1,0 360,180,-1) clouds = LD3DView.AddSphere(view3d,12600,64,"#44FFFFFF","D") 'LD3DView.AddImage(view3d,clouds,"",Program.Directory+"/exfs_cloudpic1.png","D") LD3DView.AddImage(view3d,clouds,"","https://images2.imgbox.com/1a/2e/yoaUqdV9_o.png","D") LD3DView.TranslateGeometry(view3d,clouds,10000,10000,10000) LD3DView.RotateGeometry3(view3d,clouds,.25,.05,-.25,90) LD3DView.AnimateRotation(view3d,clouds,0,0,1,0 360,199,-1) 'BUILD CUBE ENCLOSURE MODEL tubedata = "40 40 40 -40 40 40 -40 -40 40" tubedata = tubedata + " -42 -42 42" tubedata = tubedata +" -39.99 -39.99 39.99" tubedata = tubedata + " 40 -40 40 40 40 40 40 40 -40 -40 40 -40 -40 -40 -40" tubedata = tubedata + " -42 -42 -42 -39.99 -39.99 -39.99 40 -40 -40 40 40 -40" tubedata = tubedata + " 42 42 -42" tubedata = tubedata + " 39.99 39.99 -39.99" tubedata = tubedata + " -40 40 -40 -40 40 40 -40 -40 40 -40 -40 -40 40 -40 -40 40 -40 39.99" tube = LD3DView.AddTube(view3d,tubedata,.5,6,"Yellow","D") tube1 = LD3DView.AddTube(space,tubedata,3,4,"Yellow","E") 'BUILD TRAILER BOX of transport vehicle tubedata = "" tv[1] = 4 tv[2] = 4 tv[3] = 0 trailerlen = 16 * 8 For tz = -trailerlen/2-8 To trailerlen/2-8 Step 8 'build sections of transport vehicle tv[3] = tz For angt = 0 to 360 step 90 newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" EndFor endfor newv = LDVector.Rotate(tv,vz,90) '' build tube framework to engines tubedata = tubedata + 0 + ":" + 0 + ":" + (newv[3]+16) + ":" tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" newv = LDVector.Rotate(tv,vz,180) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" tubedata = tubedata + 0 + ":" + 0 + ":" + (newv[3]+16) + ":" newv = LDVector.Rotate(tv,vz,270) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" newv = LDVector.Rotate(tv,vz,360) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" For angt = 90 to 270 step 90 'add long tubes newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" tv[3] = -(tv[3]+8)-8 newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" endfor tubedata = Text.GetSubText(tubedata,1,Text.GetLength(tubedata)-1) trailer1 = LD3DView.AddTube(space,tubedata,.5,8,"White","E") trailer = LD3DView.AddTube(view3d,tubedata,.5,8,"Cyan","D") builddividers() 'dividers at each section of transport vehicle LD3DView.TranslateGeometry(view3d,dividers,0,0,-20) LD3DView.TranslateGeometry(space,dividers1,0,0,-20) 'BUILD PROPELLENT TANKS tank[1] = LD3DView.AddSphere(view3d,5.5,16,"#00BBBB","D") For i = 2 to 3 tank[i] = LD3DView.CloneObject(view3d,tank[1]) endfor tank[4] = LD3DView.AddCube(view3d,8,"#009999","D") For i = 1 To 4 LD3DView.TranslateGeometry(view3d,tank[i],0,0,-i*8+trailerlen/2 +-4) endfor tank[5] = LD3DView.AddCube(space,8,"#FFFFFF","E") LD3DView.ScaleGeometry(space,tank[5],1,1,8) LD3DView.TranslateGeometry(space,tank[5],0,0,-1*8+trailerlen/2 ) engine[1] = LD3DView.AddSphere(view3d,3,16,"Red","D") 'engine parts LD3DView.TranslateGeometry(view3d,engine[1],0,0,trailerlen/2 + 8) createmotor() 'engine parts and rocket exhaust xtras = 13 'amount of transport vehicle geometries minus one 'MOVE TRAILER & ENGINE gn1 = Text.GetSubTextToEnd(trailer1,9) For gn = gn1 to gn1 + xtras gname = "Geometry" + gn move[1] = 0 move[2] = -120 move[3] = 0 pos = LD3DView.GetPosition(view3d,gname) pos = LDVector.Add(pos,move) LD3DView.TranslateGeometry(view3d,gname,pos[1],pos[2],pos[3]) endfor 'BUILD PARKING ASSIST BOX cubical tube frame tubedata = "" For tz = -4 To 4 Step 8 tv[3] = tz For angt = 0 to 360 step 90 newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" EndFor endfor For angt = 90.1 to 271 step 90 newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" tv[3] = -tv[3] newv = LDVector.Rotate(tv,vz,angt) tubedata = tubedata + newv[1] + ":" + newv[2] + ":" + newv[3] + ":" endfor tubedata = Text.GetSubText(tubedata,1,Text.GetLength(tubedata)-1) parkingbox[1] = LD3DView.AddTube(view3d,tubedata,.1,6,"#60FFFF00","D") parkingbox[2] = "H" LD3DView.ModifyObject(view3d,parkingbox[1],"H") 'CENTER MARKING BALL centerball = LD3DView.AddSphere(view3d,.25,8,"Yellow","E") LD3DView.ModifyObject(view3d,centerball,"H") 'BUILD YELLOW GATE SPHERE MODEL gate = LD3DView.AddSphere(view3d,3,32,"Black","D") gate1 = LD3DView.AddSphere(space,3,32,"#64FFFF00","E") gateskin = LDImage.NewImage(512,512,"Yellow") LDImage.OpenWorkingImage(gateskin) For x = 1 to 512 step 32 ''add lines to sphere For y = 1 to 512 LDImage.SetWorkingImagePixel(gateskin,x,y,"Black") LDImage.SetWorkingImagePixel(gateskin,y,x+4,"Black") endfor endfor For x = 300 to 340 ''add positioning target lines LDImage.SetWorkingImagePixel(gateskin,x,356,"Black") LDImage.SetWorkingImagePixel(gateskin,x,358,"Black") endfor For y = 327 to 387 LDImage.SetWorkingImagePixel(gateskin,320,y,"Black") LDImage.SetWorkingImagePixel(gateskin,322,y,"Black") endfor LDImage.CloseWorkingImage(gateskin) GraphicsWindow.FontSize = 18 LDImage.AddText(gateskin,"EXFS ORBITAL STOREHOUSE CONTROL",20,132,"#BB0000") 'add sphere words LDImage.AddText(gateskin,"ORBITAL STOREHOUSE CONTROL EXFS",20,196,"#BB0000") LDImage.AddText(gateskin,"STOREHOUSE CONTROL EXFS ORBITAL ",20,260,"#BB0000") LDImage.AddText(gateskin,"CONTROL EXFS ORBITAL STOREHOUSE",20,324,"#BB0000") LDImage.AddText(gateskin,"EXFS ORBITAL STOREHOUSE CONTROL",20,388,"#BB0000") LD3DView.AddImage(view3d,gate,"",gateskin,"D") 'BUILD CUBE container MODELS 'cube[1] = LD3DView.AddCube(view3d,3,"Black","S") cube[1] = LD3DView.Addcube(view3d,6,"Black","S") cube1[1] = LD3DView.AddCube(space,6,tint,"E") 'door2 = ImageList.LoadImage(Program.Directory+"/exfs_door2.jpg") door2 = ImageList.LoadImage("https://images2.imgbox.com/f8/be/DVYhNTfD_o.jpg") LD3DView.AddImage(view3d,cube[1],"",door2,"D") LD3DView.TranslateGeometry(view3d,cube[1],10000,10000,10000) LD3DView.TranslateGeometry(space,cube1[1],10000,10000,10000) w=.5 For c = 2 To 27 cube[c] = LD3DView.CloneObject(view3d,cube[1]) cube1[c] = LD3DView.CloneObject(space,cube1[1]) LD3DView.TranslateGeometry(view3d,cube[c],Math.GetRandomNumber(72)-36,Math.GetRandomNumber(72)-36,Math.GetRandomNumber(72)-36) pos = LD3DView.GetPosition(view3d,cube[c]) LD3DView.TranslateGeometry(space,cube1[c],pos[1],pos[2],pos[3]) LDMath.RandomNumberSeed = c EndFor p = 3 'BUILD XXX NODE MODELS 'LD3DView.AddImage(view3d,cube[26],"",Program.Directory+"/exfs_bluebox2.jpg","D") 'LD3DView.AddImage(view3d,cube[27],"",Program.Directory+"/exfs_bluebox2.jpg","D") LD3DView.AddImage(view3d,cube[26],"","https://images2.imgbox.com/20/c0/CDPtsN2z_o.jpg","D") LD3DView.AddImage(view3d,cube[27],"","https://images2.imgbox.com/20/c0/CDPtsN2z_o.jpg","D") ffieldopacity =240 ffield ="on" shade = "#888800" shade = LDColours.SetOpacity(shade,ffieldopacity) shadeb = "#00FF00" shadeb = LDColours.SetOpacity(shadeb,20) 'BUILD BOX ENCLOSURE MODELS force field simulation 'grid = ImageList.LoadImage(Program.Directory+"/exfs_gridmap.png") grid = ImageList.LoadImage("https://images2.imgbox.com/06/32/Lvy1IiIZ_o.png") box[1] = LD3DView.AddCube(view3d,80,shadeb,"D") LD3DView.AddImage(view3d,box[1],"",grid,"E") LD3DView.SetBackMaterial(view3d,box[1],shadeb,"D") LD3DView.AddBackImage(view3d,box[1],"",grid,"E") box[2] = LD3DView.AddCube(view3d,80,shade,"D") box2 = LD3DView.AddCube(space,80,tint,"E") LD3DView.SetBackMaterial(space,box2,shade,"D") For c = 1 To 27 cubepos = LD3DView.GetPosition(view3d,cube[c]) LD3DView.SetCentre(view3d,cube[c],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") LD3DView.SetCentre(space,cube1[c],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") EndFor angle = LDVector.AngleBetween(v1,v2) cross = LDVector.CrossProduct(v1,v2) 'TRACTOR BEAM coneh = 8 color1 = LDColours.SetOpacity("White",20) tbeam = LD3DView.AddCone(view3d,1.5,.001,coneh,32,"#44FFFFFF","D") 'smoke = ImageList.LoadImage(Program.Directory+"/exfs_smoke.png") smoke = ImageList.LoadImage("https://images2.imgbox.com/69/60/3R0qoQRU_o.png") LDImage.ReplaceColour(smoke,"#FFFFFF","#22FFFFFF",0) LDImage.ReplaceColour(smoke,"#EBEBEB","#33EBEBEB",0) LDImage.ReplaceColour(smoke,"#E4E4E4","#44E4E4E4",0) LDImage.ReplaceColour(smoke,"#F4F4F4","#55F4F4F4",0) LD3DView.AddImage(view3d,tbeam,"",smoke,"D") LD3DView.SetCentre(view3d,tbeam,0,0,0,"R1R2R3") LD3DView.AnimateRotation(view3d,tbeam,0,1,0,0,360,1,-1) LD3DView.ModifyObject(view3d,tbeam,"H") 'MOVE NODES INTO POSITION LD3DView.TranslateGeometry(view3d,cube[26],-43.5, -43.5, 43.5) cubepos = LD3DView.GetPosition(view3d,cube[26]) LD3DView.SetCentre(view3d,cube[26],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") LD3DView.TranslateGeometry(space,cube1[26],-43.5, -43.5, 43.5) cubepos = LD3DView.GetPosition(space,cube1[26]) LD3DView.SetCentre(space,cube1[26],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") LD3DView.TranslateGeometry(view3d,cube[27],43.5, 43.5, -43.5) cubepos = LD3DView.GetPosition(view3d,cube[27]) LD3DView.SetCentre(view3d,cube[27],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") LD3DView.TranslateGeometry(space,cube1[27],43.5, 43.5, -43.5) cubepos = LD3DView.GetPosition(space,cube1[27]) LD3DView.SetCentre(space,cube1[27],-cubepos[1],-cubepos[2],-cubepos[3],"R1R2R3") 'MOVE GATE sphere INTO POSITION LD3DView.TranslateGeometry(view3d,gate,-42,-42,-42) pos = LD3DView.GetPosition(view3d,gate) LD3DView.SetCentre(view3d,gate,-pos[1],-pos[2],-pos[3],"R1R2R3") LD3DView.TranslateGeometry(space,gate1,-42,-42,-42) pos = LD3DView.GetPosition(space,gate1) LD3DView.SetCentre(space,gate1,-pos[1],-pos[2],-pos[3],"R1R2R3") cross = LDVector.Normalise(cross) ''build blue "crosstube" connection point for gate sphere crosstubedata1 = cross[1]+":"+cross[2]+":"+cross[3] cross = LDVector.Normalise(LDVector.CrossProduct(v1,cross)) crosstubedata2 = cross[1]+":"+cross[2]+":"+cross[3] cross = LDVector.Normalise(LDVector.CrossProduct(v1,cross)) crosstubedata3 = cross[1]+":"+cross[2]+":"+cross[3] cross = LDVector.Normalise(LDVector.CrossProduct(v1,cross)) crosstubedata4 = cross[1]+":"+cross[2]+":"+cross[3] crosstubedata = crosstubedata1+":"+crosstubedata3+":0:0:0:"+crosstubedata2+":"+crosstubedata4 crosstube = LD3DView.AddTube(view3d,crosstubedata,.6,8,"Blue","E") LD3DView.ScaleGeometry(view3d,crosstube,.05,.05,.05) LD3DView.TranslateGeometry(view3d,crosstube,-43.8,-43.8,-43.8) ''GUIDE COLUMN TO AID CORRECT POSITIONING TO GATESPHERE CONNECTION guide = LD3DView.AddTube(view3d,"-40 -40 -40 -48 -48 -48",.07,16,LDColours.SetOpacity("White",40),"E") LD3DView.ReverseNormals(view3d,guide) 'START ROTATION MOVEMENTS ANIMATIONS LD3DView.AnimateRotation(view3d,gate,1,1,1,0,360,30,-1) LD3DView.AnimateRotation2(view3d,crosstube,1,1,1,0,360,30,-1) LD3DView.AnimateRotation(space,guide,1,1,1,0,360,30,-1) LD3DView.AnimateRotation(view3d,tube,1,1,1,0,360,60,-1) LD3DView.AnimateRotation(space,tube1,1,1,1,0,360,60,-1) LD3DView.AnimateRotation(view3d,box[1],1,1,1,0,360,60,-1) LD3DView.AnimateRotation(view3d,box[2],1,1,1,0,360,60,-1) LD3DView.AnimateRotation(space,box2,1,1,1,0,360,60,-1) anistart = Clock.ElapsedMilliseconds ''TO TRACK ROTATION ANIMATION For c = 1 To 27 ''ANIMATION OF CONTAINER CUBES geonum = Text.GetSubTextToEnd(cube1[c],9) geo_ani_state[geonum] = "True" geo_ani_state[geonum-1] = "True" If c < 27 Then LD3DView.AnimateRotation(view3d,cube[c],1,1,1,0,360,60,-1) Else LD3DView.AnimateRotation2(view3d,cube[c],1,1,1,0,360,60,-1) EndIf LD3DView.AnimateRotation(space,cube1[c],1,1,1,0,360,60,-1) EndFor LD3DView.AnimateRotation(view3d,cube[27],42, 42, -42,0,360,4,-1) cubenode[1] = cube[26] cubenode[2] = cube[27] cubenode1[1] = cube1[26] cubenode1[2] = cube1[27] cube[26] = "" cube[27] = "" cube1[26] = "" cube1[27] = "" LD3DView.CameraProperties(view3d,0.125,-1,camviewang) LD3DView.AddAmbientLight(view3d,"#555555") LD3DView.AddDirectionalLight(view3d,"White",1,0,0) 'BUILD SHAPES FOR HUD DISPLAY OF VELOCITIES ETC GraphicsWindow.FontSize = 24 speedometer = Controls.AddButton("Ahead 0.000",gw * .85,gh * 0.01) LDControls.SetButtonStyle(speedometer,"#80FFFFFF","Red","Red","Maroon","Red","Red",20,"True") Controls.SetSize(speedometer,200,50) vslewometer = Controls.AddButton("Vslew 0.000",gw * .85,gh * 0.17) LDControls.SetButtonStyle(vslewometer,"#80FFFFFF","Red","Red","Maroon","Red","Red",20,"True") Controls.SetSize(vslewometer,200,50) hslewometer = Controls.AddButton("Hslew 0.000",gw * .85,gh * 0.09) LDControls.SetButtonStyle(hslewometer,"#80FFFFFF","Red","Red","Maroon","Red","Red",20,"True") Controls.SetSize(hslewometer,200,50) rollometer = Controls.AddButton("Roll 0.000",gw * .85,gh * .25) LDControls.SetButtonStyle(rollometer,"#80FFFFFF","Red","Red","Maroon","Red","Red",20,"True") Controls.SetSize(rollometer,200,50) distometer = Controls.AddButton("Dist 0.000",gw * .85,gh * .33) LDControls.SetButtonStyle(distometer,"#80FFFFFF","Red","Red","Maroon","Red","Red",20,"True") Controls.SetSize(distometer,200,50) restartbut = Controls.AddButton("Continue",gw*.4,gh*.6) LDControls.SetButtonStyle(restartbut,"#80FFFFFF","#80FFFFFF","#B0FFFFFF","Green","Red","Black",20,"True") Controls.SetSize(restartbut,200,50) Controls.HideControl(restartbut) GraphicsWindow.BrushColor = "DeepPink" GraphicsWindow.FontSize = 32 GraphicsWindow.FontBold = "True" scorepop = Shapes.AddText("Score") 'FLOATING SCORE AWARDS Shapes.Move(scorepop,gwc,ghc) subscorebox = Shapes.AddText("0") Shapes.Move(subscorebox,2,2) GraphicsWindow.BrushColor = "Lime" damagepop = Shapes.AddText("Damage") ''FLOATING DAMAGE AWARDS Shapes.Move(damagepop,gwc,ghc + 200) damagebox = Shapes.AddText("0") Shapes.Move(damagebox,2,40) GraphicsWindow.BrushColor = "#60FF4500" alertbox = Shapes.AddText("Alert") ''VARIOUS NOTIFICATION SHAPES Shapes.Move(alertbox,gw * .15,gh * .25) Shapes.HideShape(alertbox) GraphicsWindow.BrushColor = "Yellow" loadbox = Shapes.AddText("Load") Shapes.HideShape(loadbox) Shapes.Move(loadbox,gw*.1,gh*.8) Shapes.Animate(loadbox,gw+300,-200,8000) GraphicsWindow.BrushColor = "Red" deliverymessagebox = Shapes.AddText("First Delivery in progress") Shapes.HideShape(deliverymessagebox) Shapes.Move(deliverymessagebox,-gw*.1,gh*.8) Shapes.Animate(deliverymessagebox,gw+300,gh*.8,12000) finaltext = "Mission Complete"+crlf+"Score="+subscore+crlf+"Damage="+damagetot+crlf+"Elapsed Time="+eltime+crlf+"Final Score="+finalscore finalbox = Shapes.AddText("Final") Shapes.HideShape(finalbox) Shapes.Move(finalbox,gw*1.2,gh) eltimebox = Shapes.AddText("Time") Shapes.Move(eltimebox,2,80) nodesbox = Shapes.AddText("Nodes=0") Shapes.Move(nodesbox,2,120) msgbox = Shapes.AddText("Message") Shapes.HideShape(msgbox) keyhintbox = Shapes.AddText("Exospheric Freight Service Mission"+crlf+"Press K to see Keyboard Controls") Shapes.Move(keyhintbox,gw*.35,gh*.25) 'tempimage = ImageList.LoadImage(Program.Directory+"/exfs_reticle2.png") tempimage = ImageList.LoadImage("https://images2.imgbox.com/15/16/F3Ix3qos_o.png") imagewidth = ImageList.GetWidthOfImage(tempimage) imageheight = ImageList.GetHeightOfImage(tempimage) LDImage.MakeTransparent(tempimage,"#000000") reticle = Shapes.AddImage(tempimage) 'SCREEN CENTERMARKER LDShapes.Centre(reticle,gwc,ldghc) GraphicsWindow.BrushColor = "#00000000" circle = Shapes.AddEllipse(100,100) LDShapes.Centre(circle,gwc,ldghc) Shapes.HideShape(circle) redfade = LDColours.SetOpacity("#00FF00",60) GraphicsWindow.BrushColor = redfade hack = Shapes.AddText("Recognizing") LDShapes.Centre(hack,gwc,ldghc) Shapes.HideShape(hack) tichand = LDImage.NewImage(100,100,"#00000000") ''CLOCK HANDS LDImage.OpenWorkingImage(tichand) For y = 1 to 50 LDImage.SetWorkingImagePixel(tichand,50,y,"Cyan") endfor LDImage.CloseWorkingImage(tichand) secondhand = LDImage.NewImage(60,60,"#00000000") LDImage.OpenWorkingImage(secondhand) For y = 1 to 30 LDImage.SetWorkingImagePixel(secondhand,29,y,"Cyan") LDImage.SetWorkingImagePixel(secondhand,30,y,"Cyan") LDImage.SetWorkingImagePixel(secondhand,31,y,"Cyan") endfor LDImage.CloseWorkingImage(secondhand) hackclock = Shapes.AddImage(tichand) LDShapes.Centre(hackclock,gwc, ldghc) hackclock2 = Shapes.AddImage(secondhand) LDShapes.Centre(hackclock2,gwc,ldghc) Shapes.HideShape(hackclock) Shapes.HideShape(hackclock2) GraphicsWindow.BrushColor = "Yellow" syncro = Shapes.AddText("Syncronized") LDShapes.Centre(syncro,gwc,ldghc) Shapes.HideShape(syncro) GraphicsWindow.FontSize = 12 conimage = LDImage.NewImage(160,160,"#00000000") LDImage.AddText(conimage,"O",70,1,"Yellow") LDImage.AddText(conimage,"O",70,140,"Yellow") LDImage.AddText(conimage,"O",1,70,"Yellow") LDImage.AddText(conimage,"O",140,70,"Yellow") connector = Shapes.AddImage(conimage) ''CONNECTION POSITIONER FOR HUD Shapes.Zoom(connector,2,2) LDShapes.Centre(connector,gwc,ldghc) Shapes.HideShape(connector) setupcont() ''MULTIPURPOSE MESSAGE PANEL AND CONTROL PANEL mid = LD3DView.GetPosition(view3d,trailer) gn1 = Text.GetSubTextToEnd(trailer1,9) For gn = gn1 to gn1 + xtras 'ANIMATE TRAILER MOVEMENT INTO SCENE gname = "Geometry" + gn p1 = LD3DView.GetPosition(view3d,gname) p = LDVector.Subtract(mid,p1) p[1] = p[1] +3000 LD3DView.SetCentre(view3d,gname, p[1],p[2],p[3],"R1R2R3") LD3DView.AnimateRotation(view3d,gname,0,1,0,10,0,4,1) endfor GraphicsWindow.Title = "EXOSPHERIC FREIGHT SERVICE press Alt Tab for Mission Briefing" 'GETTING READY TO BEGIN starttime = Clock.ElapsedMilliseconds gname = trailer1 p1 = LD3DView.GetPosition(space,gname) p = LDVector.Subtract(mid,p1) p[1] = p[1] +3000 LDTimer.Resume(checkproximity) Timer.Resume() LDTimer.Resume(msgtimer) speednum = 1 thrustersoundon() Mouse.MouseX = gwc Mouse.MouseY = ghc Shapes.Animate(scorepop,-200,-100,3000) Shapes.Animate(damagepop,-200,0,3000) messages() startpos() LDTimer.Resume(onstarttimer) speed = 5 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(600,1)) Program.Delay(1000) LDGraphicsWindow.ResumeUpdates() 'SHOW SCENE Program.Delay(1000) TextWindow.WriteLine(crlf+t4+"LOADING COMPLETE PRESS ALT TAB") start: While "True" Program.Delay(1000) endwhile Sub testparameters deliverynum = 0 mousewheel = "True" storefull = 1 For i = 1 To 3 node[i] = "True" EndFor check3nodes() EndSub Sub onbuttonclick 'MOUSE CLICK ON CONTINUE BUTTON lastbut = Controls.LastClickedButton If lastbut = restartbut Then mousecursor = "False" Mouse.HideCursor() Controls.HideControl(restartbut) Mouse.MouseX = gwc Mouse.MouseY = ghc Controls.HideControl(finalbox) LDTimer.Pause(endgametime) interfacepanelstate = "False" EndIf EndSub Sub startpos LD3DView.ResetCamera(view3d,-208.567,-1538.067,-727.756,0.119,0.870,0.478,-0.991,0.136,-0.00) EndSub Sub var 'SET VARIABLES acel = 1.2 alertboxstate = "False" args = "" camviewang = 90 connectingstate = "False" creditmessagestate = "False" cr = Text.GetCharacter(13) crlf = cr + lf d = 0 damageamt = 0 damagetot = 0 ' Shapes.SetText(damagebox,0) Shapes.SetText(deliverymessagebox,"First Delivery in progress") deliverynum = 0 dh = Desktop.Height dw = Desktop.Width eltime = 24.22 ffield = "on" finalscore = 12532 gh = GraphicsWindow.Height ribbon = dh - gh - 1 ldghc = gh/2 ghc = ribbon + gh/2 gw = GraphicsWindow.Width gwc = gw/2 hackingstate = "False" hacktimelength = 10000 helpmsg = "True" inc = .1 interfacepanelstate = "False" keyhelpstate = "False" lf = Text.GetCharacter(10) m = .3 maxspeed = .6 mousezoom = camviewang/600 mousewheel = "False" node[1] = "False" node[2] = "False" node[3] = "False" nodenum = 10 pic = 1 pixel[1][1] = 683 pixel[1][2] = 395 pixel[2][1] = 683 pixel[2][2] = 325 pixel[3][1] = 753 pixel[3][2] = 395 pixel[4][1] = 683 pixel[4][2] = 465 pixel[5][1] = 613 pixel[5][2] = 395 ribbon = dh - gh - 1 pixel[1][1] = gwc 'center of connector guide pixel[1][2] = ghc pixel[2][1] = gwc ' 12 oclock pixel[2][2] = dh * .334 pixel[3][1] = gw * .601 '3 oclock pixel[3][2] = dh * .516 pixel[4][1] = gwc '6 oclock pixel[4][2] = dh * .698 pixel[5][1] = gw * .398 '9 oclock pixel[5][2] = dh * .514 rtbleft = gw*.62 rtbtop = gh * .38 sp = Text.GetCharacter(32) storefull = 23 t1 = Text.GetCharacter(9) t2 = t1 + t1 t3 = t2+t1 t4 = t2+t2 tint = "#64FF0000" tractorbeamstate = "False" v1[1] = -1 v1[2] = -1 v1[3] = -1 v2[1] = 0 v2[2] = 0 v2[3] = 1 vx[1] = 1 vx[2] = 0 vx[3] = 0 vy[1] = 0 vy[2] = 1 vy[3] = 0 vz[1] = 0 vz[2] = 0 vz[3] = 1 xr = 0 yr = 0 zr = 0 EndSub Sub upkey 'KEY HANDLING If Text.StartsWith(key1,"D") and Text.GetLength(key1) > 1 Then 'SPEED speednum = Text.GetSubTextToEnd(key1,2) speed = .066666666 * speednum Controls.SetButtonCaption(speedometer,"Ahead "+LDMath.FixDecimal(speed*1000,1)) thrustersoundon() EndIf If key1 = "F1" Then 'CREDITS For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.HideControl("Control"+i) endfor If creditmessagestate = "False" Then creditmessagestate = "True" credits() Elseif creditmessagestate = "True" then creditmessagestate = "False" Controls.HideControl(rtb) EndIf Program.Delay(100) EndIf If key1 = "H" Then 'HELP TOGGLE if helpmsg = "True" Then helpmsg = "False" LDTimer.Pause(msgtimer) Shapes.HideShape(msgbox) ElseIf helpmsg = "False" then helpmsg = "True" LDTimer.Resume(msgtimer) Shapes.ShowShape(msgbox) EndIf EndIf If key1 = "K" Then 'KEYBOARD HELP TOGGLE Shapes.HideShape(keyhintbox) For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.HideControl("Control"+i) endfor If keyhelpstate = "False" Then keyhelpstate = "True" setupkeyhelp() ElseIf keyhelpstate = "True" then keyhelpstate = "False" EndIf EndIf If key1 = "N1" Then testparameters() EndIf If key1 = "T" Then 'TRACTOR BEAM OFF HANDLING if LDCall.Function("is_cube_in_spot",tractorhit[1]) then tractorbeamstate = "False" LDTimer.Pause(onbeamtimer) tractorbeamsoundoff() geonum = Text.GetSubTextToEnd(tractorhit[1],9) geo_ani_state[geonum] = "stored" geo_ani_state[geonum-1] = "stored" checktrailerload() parkingbox[2] = "H" LD3DView.ModifyObject(view3d,parkingbox[1],"H") Else cubepos = LD3DView.GetPosition(view3d,tractorhit[1]) mid = LD3DView.GetPosition(view3d,centerball) mid[3] = Math.Floor(cubepos[3] / 8) * 8 + 4 distancefromtrailer = LDVector.Length(LDVector.Subtract(cubepos,mid)) If distancefromtrailer > 20 Then tractorbeamstate = "False" LDTimer.Pause(onbeamtimer) tractorbeamsoundoff() parkingbox[2] = "H" LD3DView.ModifyObject(view3d,parkingbox[1],"H") geonum = Text.GetSubTextToEnd(tractorhit[1],9) geo_ani_state[geonum] = "parked" geo_ani_state[geonum-1] = "parked" EndIf EndIf EndIf If Text.IsSubText(key1,"QWEASDZXC") Then thrustersoundoff() EndIf If key1 = "LeftShift" Then 'ALL STOP speed = 0 hslew = 0 vslew = 0 roll = 0 Controls.SetButtonCaption(speedometer,"Ahead "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) Controls.SetButtonCaption(rollometer,"Roll "+LDMath.FixDecimal(roll*1000,1)) thrustersoundon() EndIf If key1 = "O" Then 'CONTROLLER INTERFACE PANEL threenodestate = 0 For nn = 1 To 3 If node[nn] = "True" Then threenodestate = threenodestate + 1 EndIf EndFor Shapes.HideShape(alertbox) If interfacepanelstate = "False" Then interfacepanelstate = "True" LDControls.RichTextBoxSetText(rtb,interfacetext,"False") LDCall.Function3("wordmark","EXFS ORBITAL STOREHOUSE CONTROLLER INTERFACE","32,bold",0) mousecursor = "True" Mouse.ShowCursor() LDControls.RadioButtonSet(exit1) For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.ShowControl("Control"+i) endfor Mouse.MouseX = gw*.655 Mouse.MouseY = gh*.90 If threenodestate < 2 Then Controls.HideControl(exitsave) EndIf ElseIf interfacepanelstate = "True" then Mouse.hideCursor() mousecursor = "False" Mouse.MouseX = gwc Mouse.MouseY = ghc interfacepanelstate = "False" For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.HideControl("Control"+i) endfor If ffield Then LDControls.RadioButtonSet(ffon) Else LDControls.RadioButtonSet(ffoff) EndIf If gfield Then LDControls.RadioButtonSet(gfon) Else LDControls.RadioButtonSet(gfoff) EndIf EndIf key1 = "" EndIf If key1 = "P" Then ''TO SEND CAMERA DATA TO THE CLIPBOARD campos = LD3DView.GetCameraPosition(view3d) camdir = LD3DView.GetCameraDirection(view3d) camup = LD3DView.GetCameraUpDirection(view3d) For i = 1 To 3 camdir[i] = LDMath.FixDecimal(camdir[i],3) campos[i] = LDMath.FixDecimal(campos[i],3) camup[i] = LDMath.FixDecimal(camup[i],3) EndFor camdat = campos[1] + "," + campos[2] + "," +campos[3] + "," + camdir[1] + "," + camdir[2] + ","+ camdir[3] + "," camdat = camdat + camup[1] + "," + camup[2] + "," + camup[3] + crlf LDClipboard.SetText(camdat) EndIf key1 = "" EndSub Sub onkey 'HOLDING KEY HANDLING FOR TRUSTER MOVEMENT KEYS key1 = GraphicsWindow.lastkey If hitt[1] <> "" Then campos = LD3DView.GetCameraPosition(view3d) camup = LD3DView.GetCameraUpDirection(view3d) EndIf If key1 = "E" Then thrustersoundon() If roll = 0 Then roll = .01 ElseIf roll > 0 then roll = roll * acel Else roll = roll / acel EndIf If Math.Abs(roll) > maxspeed * 1.6 Then roll = maxspeed * 1.6 * roll / Math.Abs(roll) EndIf Controls.SetButtonCaption(rollometer,"Roll "+LDMath.FixDecimal(roll*1000,1)) EndIf If key1 = "Q" Then thrustersoundon() If roll = 0 Then roll = -.01 ElseIf roll > 0 then roll = roll / acel Else roll = roll * acel EndIf If Math.Abs(roll) > maxspeed * 1.6 Then roll = maxspeed * 1.6 * roll / Math.Abs(roll) EndIf Controls.SetButtonCaption(rollometer,"Roll "+LDMath.FixDecimal(roll*1000,1)) EndIf If key1 = "R" Then thrustersoundon() roll = 0 Controls.SetButtonCaption(rollometer,"Roll "+LDMath.FixDecimal(roll*1000,1)) EndIf If key1 = "A" Then thrustersoundon() If hslew = 0 Then hslew = .01 ElseIf hslew > 0 then hslew = hslew * acel Else hslew = hslew / acel EndIf If Math.Abs(hslew) > maxspeed Then hslew = maxspeed * hslew / Math.Abs(hslew) EndIf Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) If Math.Abs(hslew) < .001 Then hslew = 0 EndIf EndIf If key1 = "D" Then thrustersoundon() If hslew = 0 Then hslew = -.01 ElseIf hslew > 0 then hslew = hslew / acel Else hslew = hslew * acel EndIf If Math.Abs(hslew) > maxspeed Then hslew = maxspeed * hslew / Math.Abs(hslew) EndIf Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) If Math.Abs(hslew) < .001 Then hslew = 0 EndIf EndIf If key1 = "Z" Then thrustersoundon() If vslew = 0 Then vslew = .01 ElseIf vslew > 0 then vslew = vslew * acel Else vslew = vslew / acel EndIf If Math.Abs(vslew) > maxspeed Then vslew = maxspeed * vslew / Math.Abs(vslew) EndIf Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) If Math.Abs(vslew) < .001 Then vslew = 0 EndIf EndIf If key1 = "C" Then thrustersoundon() If vslew = 0 Then vslew = -.01 ElseIf vslew > 0 then vslew = vslew / acel Else vslew = vslew * acel EndIf If Math.Abs(vslew) > maxspeed Then vslew = maxspeed * vslew / Math.Abs(vslew) EndIf Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) If Math.Abs(vslew) < .001 Then vslew = 0 EndIf EndIf If key1 = "V" Then thrustersoundon() vslew = 0 Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) EndIf If key1 = "F" Then thrustersoundon() hslew = 0 Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) Program.Delay(d) EndIf If key1 = "W" Then thrustersoundon() If speed = 0 Then speed = .01 ElseIf speed > 0 then speed = speed * acel Else speed = speed / acel EndIf If Math.Abs(speed) < .001 Then speed = 0 EndIf If Math.Abs(speed) > maxspeed Then speed = maxspeed * speed / Math.Abs(speed) EndIf Controls.SetButtonCaption(speedometer,"Ahead "+LDMath.FixDecimal(speed*1000,1)) EndIf If key1 = "S" Then thrustersoundon() If speed = 0 Then speed = -.01 ElseIf speed < 0 then speed = speed * acel Else speed = speed / acel EndIf If Math.Abs(speed) > maxspeed Then speed = maxspeed * speed / Math.Abs(speed) EndIf Controls.SetButtonCaption(speedometer,"Ahead "+LDMath.FixDecimal(speed*1000,1)) If Math.Abs(speed) < .001 Then speed = 0 EndIf EndIf If key1 = "X" Then thrustersoundon() speed = 0 Controls.SetButtonCaption(speedometer,"Ahead "+LDMath.FixDecimal(speed*1000,1)) EndIf If key1 = "Escape" Then Controls.HideControl(finalbox) key1 = "" ans = LDDialogs.Confirm("Are you sure you want to quit?","End Program") If ans = "Yes" then Program.End() EndIf Mouse.MouseX = gwc Mouse.MouseY = ghc EndIf EndSub Sub checkhacklock 'CHECKING FOR PROXIMITY TO NODES hitt = LD3DView.HitTest(view3d,-1,-1) If (hitt[1] = cubenode[2] or hitt[1] = cubenode[1]) And hitt[2] < 18 Then If nodenum = 10 Then If hitt[1] = cubenode[1] Then nodenum = 1 ElseIf hitt[1] = cubenode[2] then nodenum = 2 EndIf EndIf If node[nodenum] = "Working" Then If Clock.ElapsedMilliseconds > hacktime Then Shapes.HideShape(circle) Shapes.HideShape(hackclock) Shapes.HideShape(hackclock2) Shapes.HideShape(hack) LDTimer.Pause(tryhack) node[nodenum] = "True" nodenum = 10 Shapes.SetText(syncro,"Syncronized") Shapes.ShowShape(syncro) LDShapes.AnimateOpacity(syncro,1000,3) LDTimer.Resume(syncrotime) LDCall.Function("scoreit",1500) check3nodes() EndIf ElseIf node[nodenum] = "False" Then node[nodenum] = "Working" hacktime = Clock.ElapsedMilliseconds + hacktimelength LDTimer.Resume(tryhack) Shapes.ShowShape(circle) Shapes.ShowShape(hackclock) Shapes.showShape(hackclock2) LDShapes.AnimateRotation(hackclock,1000,0) LDShapes.AnimateRotation(hackclock2,hacktimelength,0) Shapes.ShowShape(hack) LDShapes.AnimateOpacity(hack,1500,0) ElseIf node[nodenum] = "True" Then Shapes.SetText(syncro,"Syncronized") Shapes.ShowShape(syncro) LDShapes.AnimateOpacity(syncro,1000,3) LDTimer.Resume(syncrotime) LDTimer.Pause(tryhack) nodenum = 10 EndIf ElseIf node[nodenum] = "Working" then Shapes.HideShape(circle) Shapes.HideShape(hackclock) Shapes.HideShape(hackclock2) Shapes.HideShape(hack) LDTimer.Pause(tryhack) node[nodenum] = "False" nodenum = 10 EndIf EndSub Sub onmousedown 'NOT USED If Mouse.IsLeftButtonDown Then EndIf If Mouse.IsrightButtonDown Then EndIf EndSub Sub parkguide ''CONTROL DISPLAY AND MOVEMENT OF BOX AID FOR PLACING CUBES INTO TRANSPORT VEHICLE cbpos = LD3DView.GetPosition(view3d, centerball) temp = LDVector.Subtract(tractorpos,cbpos) dist1 = LDMath.Convert2Radial(tractorpos[1],tractorpos[2],cbpos[1],cbpos[2]) If dist1[1] < 12 and tractorpos[3] < 25 and tractorpos[3] > -73 Then If parkingbox[2] = "H" Then LD3DView.ModifyObject(view3d,parkingbox[1],"S") parkingbox[2] = "S" EndIf LD3DView.TranslateGeometry(view3d,parkingbox[1],tractorpos[1],tractorpos[2],tractorpos[3]) checkboxtest = checkboxtest + 1 If checkboxtest > 3 Then checkboxtest = 0 collisioncheckbox() EndIf Else LD3DView.ModifyObject(view3d,parkingbox[1],"H") parkingbox[2] = "H" EndIf EndSub Sub tryconnecting ''CHECKING FOR PROPER POSITION AND ROTATION TO GATE SPHERE FOR CONNECTION LD3DView.ModifyObject(view3d,guide,"H") connectcount = 0 For p = 1 To 5 hitc = LD3DView.HitTest(view3d,pixel[p][1],pixel[p][2]) if hitc[1] = crosstube Then connectcount = connectcount + 1 EndIf EndFor LD3DView.ModifyObject(view3d,guide,"S") If connectcount > 0 Then Shapes.ShowShape(connector) If hitc[2] < .3 Then Shapes.SetText(alertbox,"Match Rotational Speed") EndIf Else Shapes.HideShape(connector) EndIf If connectcount < 1 Then Shapes.HideShape(alertbox) alertboxstate = "False" EndIf If connectcount = 5 and connectingstate = "False" Then connectime = Clock.ElapsedMilliseconds + hacktimelength Shapes.ShowShape(circle) Shapes.ShowShape(hackclock) Shapes.showShape(hackclock2) LDShapes.AnimateRotation(hackclock,1000,0) LDShapes.AnimateRotation(hackclock2,hacktimelength,1) Shapes.SetText(hack,"Connecting") Shapes.ShowShape(hack) LDShapes.AnimateOpacity(hack,500,0) connectingstate="True" ElseIf connectcount < 5 and connectingstate ="True" then Shapes.HideShape(circle) Shapes.HideShape(hackclock) Shapes.HideShape(hackclock2) Shapes.HideShape(hack) connectingstate = "False" LDTimer.Pause(tryconnecttime) Shapes.HideShape(connector) EndIf If Clock.ElapsedMilliseconds > connectime and connectingstate = "True" Then Shapes.HideShape(circle) Shapes.HideShape(hackclock) Shapes.HideShape(hackclock2) Shapes.HideShape(hack) LDTimer.Pause(tryconnecttime) Shapes.HideShape(connector) node[3] = "True" Shapes.SetText(syncro,"connected") Shapes.ShowShape(syncro) LDShapes.AnimateOpacity(syncro,500,2) LDTimer.Resume(syncrotime) LDCall.Function("scoreit",2500) check3nodes() speed = -1 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) LDTimer.Resume(onbumptimer) alertboxstate = "False" Shapes.HideShape(alertbox) EndIf EndSub Sub onldtimer 'TIMER HANDLING timername = LDTimer.LastTimer If timername = msgtimer Then ''MESSAGES msgcount = msgcount + 1 Shapes.SetText(msgbox,msg[msgcount]) Shapes.Move(msgbox,gw,gh*.85) Shapes.ShowShape(msgbox) Shapes.Animate(msgbox,2,gh*.85,10000) if msgcount >= msgtot Then msgcount = 0 EndIf EndIf If timername = endgametime Then 'END GAME If deliverynum = 1 Then Controls.SetButtonCaption(restartbut,"Continue") Controls.ShowControl(restartbut) Mouse.ShowCursor() mousecursor = "True" EndIf EndIf If timername = onstarttimer Then ''TIMER AT BEGINNING FLY INTO SCENE hit = LD3DView.HitTest(view3d,-1,-1) If hit[2] < 6300 Then LDTimer.Pause(onstarttimer) speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) speednum = 1 thrustersoundon() Mouse.HideCursor() mousecursor = "False" pos = LD3DView.GetPosition(view3d,trailer) LD3DView.TranslateGeometry(view3d,centerball,pos[1],pos[2],pos[3]-24) gn1 = Text.GetSubTextToEnd(trailer1,9) For gn = gn1 + xtras-2 To gn1 + xtras gname = "Geometry"+gn LD3DView.ModifyObject(view3d,gname,"H") EndFor buildtrailercollisionframes() 'FOR COLLISION DETECTION IN SPACE VIEWPORT EndIf EndIf If timername = onbumptimer Then ''TIMER FOR AFTER A BUMP COLLSION speed = speed/3 vslew = vslew/3 hslew = hslew/3 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) LDTimer.Pause(onbumptimer) EndIf If timername = onbeamtimer Then tbeamcontrol() ''TRACTOR BEAM DISPLAY CONTROL EndIf If timername = thrusttimer Then thrustersoundoff() EndIf If timername = checkproximity Then 'CHECKING FOR PROXIMITY TO NODES hitt = LD3DView.HitTest(space,-1,-1) If (hitt[1] = cubenode1[1] Or hitt[1] = cubenode1[2]) And hitt[2] < 18 Then LDTimer.Resume(tryhack) EndIf If hitt[1] = gate1 Then If hitt[2] < 6 Then speed = hitt[2] * .006 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) If hitt[2] < .21 Then speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) EndIf If alertboxstate <> "active" Then Shapes.SetText(alertbox,"Auto Speed Control Engaged") Shapes.ShowShape(alertbox) LDShapes.AnimateZoom(alertbox,3000,10,2,2) alertboxstate = "active" EndIf EndIf If hitt[2] < 2 Then If connectingstate = "False" Then LDTimer.Resume(tryconnecttime) EndIf ElseIf node[3] = "True" then Shapes.HideShape(alertbox) Shapes.SetText(syncro,"connected") Shapes.ShowShape(syncro) LDShapes.AnimateOpacity(syncro,500,2) LDTimer.Resume(syncrotime) EndIf EndIf EndIf If timername = tryconnecttime Then tryconnecting() 'HANDLING CONNECTION TO YELLOW SPHERE EndIf If timername = tryhack Then checkhacklock() 'HANDLING CONNECTION TO BLUE NODES EndIf If timername = syncrotime Then 'HIDING MESSAGE AFTER ELAPSED TIME LDTimer.Pause(syncrotime) Shapes.HideShape(syncro) EndIf If timername = forcefieldtime Then 'FORCE FIELD ON OR OFF DISPLAY If ffield = "True" and ffieldopacity = 0 Then finc = 10 LD3DView.ModifyObject(view3d,box[2],"S") LD3DView.ModifyObject(view3d,box[1],"S") LD3DView.ModifyObject(space,box2,"S") EndIf If ffield = "False" And ffieldopacity = 240 Then finc = - 10 EndIf ffieldopacity = ffieldopacity + finc shade = LDColours.SetOpacity("#888800", ffieldopacity) LD3DView.ResetMaterial(view3d,box[2],shade,"D") If ffieldopacity = 240 or ffieldopacity = 0 Then LDTimer.Pause(forcefieldtime) If ffieldopacity = 0 Then LD3DView.ModifyObject(view3d,box[2],"H") LD3DView.ModifyObject(view3d,box[1],"H") LD3DView.ModifyObject(space,box2,"H") ffield = "False" ElseIf ffieldopacity = 240 then ffield = "True" EndIf EndIf EndIf EndSub Sub ontimer 'TIMER FOR CAMERA MOVEMENTS if Math.Remainder(hittest,4) = 0 Then campos1 = LD3DView.GetCameraPosition(view3d) LD3DView.MoveCamera(view3d,0,0,roll,speed) campos = LD3DView.GetCameraPosition(view3d) camdir = LD3DView.GetCameraDirection(view3d) camup = LD3DView.GetCameraUpDirection(view3d) camrht = LDVector.CrossProduct(camup, camdir) newcampos = LDVector.Add(campos,LDVector.Add(LDVector.Multiply(camup, vslew),LDVector.Multiply(camrht,hslew))) LD3DView.ResetCamera(view3d,newcampos[1],newcampos[2],newcampos[3],camdir[1],camdir[2],camdir[3],camup[1],camup[2],camup[3]) LD3DView.ResetCamera(space,newcampos[1],newcampos[2],newcampos[3],camdir[1],camdir[2],camdir[3],camup[1],camup[2],camup[3]) campos2 = LD3DView.GetCameraPosition(view3d) velocityvec = LDVector.Subtract(campos1,campos2) velocity = LDVector.Length(velocityvec) EndIf hittest = hittest + 1 If hittest = 3 And tractorbeamstate = "False" Then 'CHECK FOR TRACTOR BEAM ACTIVATION IN SPACE LD3DView.ModifyObject(space,trailerbb1,"H") disthit = LD3DView.HitTest(space,-1,-1) LD3DView.ModifyObject(space,trailerbb1,"S") Controls.SetButtonCaption(distometer,"Dist "+LDMath.FixDecimal(disthit[2],3)) if Array.ContainsValue(cube1,disthit[1]) and disthit[2] < 8 Then tractorhit = disthit tractorhit[3] = "Geometry"+(Text.GetSubTextToEnd(tractorhit[1],9)-1) geonum = Text.GetSubTextToEnd(tractorhit[1],9) If geo_ani_state[geonum] <> "stored" Then If geo_ani_state[geonum] = "True" Then aniremain = Math.Remainder(Clock.ElapsedMilliseconds - anistart,60000)/60000 LD3DView.AnimateRotation(view3d,tractorhit[1],1,1,1,360*aniremain,360,1,1) LD3DView.AnimateRotation(space,tractorhit[3],1,1,1,360*aniremain,360,1,1) LD3DView.SetCentre(view3d,tractorhit[1],0,0,0,"R1R2R3") LD3DView.SetCentre(space,tractorhit[3],0,0,0,"R1R2R3") geo_ani_state[geonum] = "False" geo_ani_state[geonum-1] = "False" EndIf tractorbeamstate = "True" tractorbeamsoundon() EndIf EndIf EndIf If hittest > 6 Then ''CHECK FOR COLLISION AT CAMERA POSITION hittest = 0 eltime = LDMath.FixDecimal((Clock.ElapsedMilliseconds-starttime)/60000,2) Shapes.SetText(eltimebox,eltime) collisioncheckcamera() hitt = LD3DView.HitTest(space,-1,-1) EndIf EndSub Sub collisioncheckbox 'CHECK FOR COLLISION OF CONTAINER IN TRACTOR BEAM campos4 = LD3DView.GetCameraPosition(view3d) camdir4 = LD3DView.GetCameraDirection(view3d) camup4 = LD3DView.GetCameraUpDirection(view3d) LD3DView.ResetCamera(space,tractorpos[1],tractorpos[2],tractorpos[3],camdir4[1],camdir4[2],camdir4[3],camup4[1],camup4[2],camup4[3]) hittest = 0 ''hittest front back left right up down hitspace[1] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[2] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[3] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[4] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) LD3DView.MoveCamera(space,0,90,0,0) hitspace[5] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,0,180,0,0) hitspace[6] = LD3DView.HitTest(space,-1,-1) LD3DView.ResetCamera(space,campos4[1],campos4[2],campos4[3],camdir4[1],camdir4[2],camdir4[3],camup4[1],camup4[2],camup4[3]) If hitspace[1][2] = "" Then hitspace[1][2] = 99 EndIf nearest[2] = hitspace[1][2] nearest[1] = 1 For i1 = 2 To 6 ''find nearest hit of six directions If hitspace[i1][2] < nearest[2] and hitspace[i1][1] <> "" Then nearest[1] = i1 nearest[2] = hitspace[i1][2] EndIf EndFor i1 = nearest[1] If hitspace[i1][1] <> gate1 Then If hitspace[i1][2] < 3.3 and hitspace[i1][1] <> "" Then 'WHAT TO DO UPON A COLLISION OF A CONTAINER IN TRACTOR BEAM bumpsoundon() If speed = 0 Then bounce = .05 Else bounce = speed/2 EndIf damageamt = Math.Round(Math.Abs(bounce) * 200) damagetot = damagetot + damageamt Shapes.SetText(damagepop,"Damage "+damageamt) Shapes.SetText(damagebox,damagetot) Shapes.Move(damagepop,gwc,ghc) Shapes.Animate(damagepop,-200,0,2000) If i1 = 1 Then speed = -(speed+bounce) LD3DView.MoveCamera(view3d,0,0,0,-1-bounce) Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) ElseIf i1 = 2 then hslew = Math.Abs(speed)+Math.Abs(hslew)+bounce speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) ElseIf i1 = 3 then speed = -(speed+bounce) LD3DView.MoveCamera(view3d,0,0,0,1+bounce) Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) ElseIf i1 = 4 then hslew = -(Math.Abs(speed)+Math.Abs(hslew)+bounce) speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) ElseIf i1 = 5 then vslew = -(Math.Abs(speed)+Math.Abs(vslew)+bounce) speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) ElseIf i1 = 6 then vslew = Math.Abs(speed)+Math.Abs(vslew)+bounce speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) EndIf LDTimer.Resume(onbumptimer) EndIf EndIf EndSub Sub collisioncheckcamera ''hittest front left back right up down hitspace[1] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[2] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[3] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) hitspace[4] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,90,0,0,0) LD3DView.MoveCamera(space,0,90,0,0) hitspace[5] = LD3DView.HitTest(space,-1,-1) LD3DView.MoveCamera(space,0,180,0,0) hitspace[6] = LD3DView.HitTest(space,-1,-1) If hitspace[1][2] = "" Then hitspace[1][2] = 99 EndIf nearest[2] = hitspace[1][2] nearest[1] = 1 For i1 = 2 To 6 ''find nearest hit of six directions If hitspace[i1][2] < nearest[2] and hitspace[i1][1] <> "" Then nearest[1] = i1 nearest[2] = hitspace[i1][2] EndIf EndFor i1 = nearest[1] If hitspace[i1][1] <> gate1 Then If hitspace[i1][2] < 2.5 and hitspace[i1][1] <> "" Then 'WHAT TO DO UPON A COLLISION IN CAMERA AREA bumpsoundon() If speed = 0 Then bounce = .2 Else bounce = speed * 2 EndIf damageamt = Math.Round(Math.Abs(bounce) * 200) damagetot = damagetot + damageamt Shapes.SetText(damagepop,"Damage "+damageamt) Shapes.SetText(damagebox,damagetot) Shapes.Move(damagepop,gwc,ghc) Shapes.Animate(damagepop,-200,0,2000) If i1 = 1 Then speed = -(speed+bounce) LD3DView.MoveCamera(view3d,0,0,0,-1-bounce) Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) ElseIf i1 = 2 then hslew = Math.Abs(speed)+Math.Abs(hslew)+bounce speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) ElseIf i1 = 3 then speed = -(speed+bounce) LD3DView.MoveCamera(view3d,0,0,0,1+bounce) Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) ElseIf i1 = 4 then hslew = -(Math.Abs(speed)+Math.Abs(hslew)+bounce) speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(hslewometer,"Hslew "+LDMath.FixDecimal(hslew*1000,1)) ElseIf i1 = 5 then vslew = -(Math.Abs(speed)+Math.Abs(vslew)+bounce) speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) ElseIf i1 = 6 then vslew = Math.Abs(speed)+Math.Abs(vslew)+bounce speed = 0 Controls.SetButtonCaption(speedometer,"Speed "+LDMath.FixDecimal(speed*1000,1)) Controls.SetButtonCaption(vslewometer,"Vslew "+LDMath.FixDecimal(vslew*1000,1)) EndIf LDTimer.Resume(onbumptimer) EndIf EndIf EndSub sub onmousedoubleclick 'NOT USED EndSub Sub onmousewheel If mousewheel Then move = LDEvents.LastMouseWheelDelta LD3DView.MoveCamera(view3d,0,0,0,move*3) EndIf EndSub Sub onmousemove If mousecursor = "False" Then mx = (Mouse.MouseX - gwc) * mousezoom my = -(Mouse.MouseY - ghc) * mousezoom LD3DView.MoveCamera(view3d,mx,my,0,0) Mouse.MouseX = gwc Mouse.MouseY = ghc speednum = -9 thrustersoundon() EndIf EndSub Sub setupcont 'setup control interface panel rtb = LDControls.AddRichTextBox(.36*gw,.6*gh) Controls.HideControl(rtb) GraphicsWindow.FontSize = 14 GraphicsWindow.BrushColor = "Black" ffon = LDControls.AddRadioButton("Force Field On","ff") Controls.HideControl(ffon) LDControls.RadioButtonSet(ffon) ffoff = LDControls.AddRadioButton("Force Field Off","ff") Controls.HideControl(ffoff) gfon = LDControls.AddRadioButton("Gravity Field On","gf") Controls.HideControl(gfon) LDControls.RadioButtonSet(gfon) gfoff = LDControls.AddRadioButton("Gravity Field Off","gf") Controls.HideControl(gfoff) exitsave = LDControls.AddRadioButton("Exit & Save","ex") Controls.HideControl(exitsave) exit = LDControls.AddRadioButton("Exit Only","ex") Controls.HideControl(exit) exit1 = LDControls.AddRadioButton("","ex") Controls.Move(exit1,gw,1) LDControls.RadioButtonSet(exit1) Controls.Move(rtb,rtbleft,rtbtop) Controls.Move(ffon,gw*.655,gh*.86) Controls.Move(ffoff,gw*.84,gh*.86) Controls.Move(gfon,gw*.655,gh*.89) Controls.Move(gfoff,gw*.84,gh*.89) Controls.Move(exitsave,gw*.655,gh*.92) Controls.Move(exit,gw*.84,gh*.92) ffield = LDControls.RadioButtonGet(ffon) gfield = LDControls.RadioButtonGet(gfon) LDControls.RichTextBoxReadOnly = "False" LDControls.RichTextBoxFontSize = 16 LDControls.RichTextBoxFontBackground = "PaleGoldenrod" LDControls.RichTextBoxFontForeground = "Black" LDControls.RichTextBoxMargins(25,15,25,25) LDControls.RichTextBoxCaseSensitive = "True" LDControls.RichTextBoxDefault(rtb) LDControls.RichTextBoxClear(rtb) msg = "EXFS ORBITAL STOREHOUSE CONTROLLER INTERFACE"+crlf+crlf msg = msg + "ACCESS STATUS:"+t3+"Connected"+crlf msg = msg + "Wireless Enabled:"+t3+"Yes"+crlf msg = msg + "SSID:"+t4+"XKYQ4RK"+crlf msg = msg + "Channel:"+t4+"79264"+crlf msg = msg + "Security Enabled:"+t3+"No"+crlf msg = msg + "WEP64:"+t4+"N/A"+crlf msg = msg + "WEP 802.1x"+t3+"N/A"+crlf msg = msg + "WPA2:"+t4+"HWD6VTD88HSNWHTLJ"+crlf msg = msg + "_________________________________________________________________"+crlf interfacetext = msg EndSub Sub wordmark ''RICH TEXT BOX TEXT MARKING words = LDText.Split(args[1],",") marks = LDText.Split(args[2],",") For i = 1 To Array.GetItemCount(marks) If marks[i] = "gray" Then LDControls.RichTextBoxFontForeground = "DarkGray" ElseIf marks[i] = "italic" Then LDControls.RichTextBoxFontItalic = "True" Elseif marks[i] = "highlight" Then LDControls.RichTextBoxFontBackground = "White" elseif marks[i] = "black" then LDControls.RichTextBoxFontForeground = "Black" elseif marks[i] = "bold" then LDControls.RichTextBoxFontBold = "True" Elseif marks[i] / 2 = marks[i] * .5 Then LDControls.RichTextBoxFontSize = marks[i] EndIf EndFor For i = 1 To Array.GetItemCount(words) LDControls.RichTextBoxWord(rtb,words[i],args[3]) EndFor EndSub Sub onradioclick ''HANDLING RADIO CLICKS lastradio = LDControls.LastRadioButton If lastradio = exitsave Then 'EXIT AND SAVE Sound.PlayClick() For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.HideControl("Control"+i) endfor toggleinterfacepanelstate() mousecursor = "False" Mouse.HideCursor() Mouse.MouseX = gwc Mouse.MouseY = ghc If gfield <> LDControls.RadioButtonGet(gfon) Then gfield = LDControls.RadioButtonGet(gfon) If gfield = "False" Then For i2 = 2 To 25 ''gravity off CONTROL posc = LD3DView.GetPosition(view3d,cube[i2]) dirc = LDVector.Normalise(posc) newposc = LDVector.Multiply(dirc,1000) aniremain = Math.Remainder(Clock.ElapsedMilliseconds - anistart,60000)/60000 LD3DView.AnimateRotation(view3d,cube[i2],1,1,1,360*aniremain,360*aniremain,.001,1) LD3DView.AnimateRotation(space,cube1[i2],1,1,1,360*aniremain,360*aniremain,.001,1) LD3DView.SetCentre(view3d,cube[i2],0,0,0,"R1R2R3") LD3DView.TranslateGeometry(view3d,cube[i2],posc[1],posc[2],posc[3]) LD3DView.SetCentre(space,cube1[i2],0,0,0,"R1R2R3") LD3DView.TranslateGeometry(space,cube1[i2],posc[1],posc[2],posc[3]) LD3DView.AnimateTranslation(view3d,cube[i2],newposc[1],newposc[2],newposc[3],199) LD3DView.AnimateTranslation(space,cube1[i2],newposc[1],newposc[2],newposc[3],199) EndFor EndIf EndIf If ffield <> LDControls.RadioButtonGet(ffon) Then 'FORCE FIELD CONTROL ffield = LDControls.RadioButtonGet(ffon) If ffield = "True" Then ffieldopacity = 0 LDTimer.Resume(forcefieldtime) Else ffieldopacity = 240 LDTimer.Resume(forcefieldtime) EndIf EndIf EndIf If lastradio = exit Then 'EXIT NO SAVE toggleinterfacepanelstate() For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.HideControl("Control"+i) If ffield Then LDControls.RadioButtonSet(ffon) Else LDControls.RadioButtonSet(ffoff) EndIf If gfield Then LDControls.RadioButtonSet(gfon) Else LDControls.RadioButtonSet(gfoff) EndIf endfor ffield = LDControls.RadioButtonGet(ffon) gfield = LDControls.RadioButtonGet(gfon) mousecursor = "False" Mouse.HideCursor() Mouse.MouseX = gwc Mouse.MouseY = ghc EndIf EndSub Sub toggleinterfacepanelstate 'SET THE STATE OF INTERFACE PANEL VARIABLES SHOW OR HIDE If interfacepanelstate = "False" Then interfacepanelstate = "True" ElseIf interfacepanelstate = "True" then interfacepanelstate = "False" EndIf EndSub Sub tractorbeamsoundoff ''SOUNDS For chan = 2 to 5 LDMusic.EndNote(note[chan]) Endfor LD3DView.ModifyObject(view3d,tbeam,"H") LDTimer.Pause(onbeamtimer) EndSub Sub tractorbeamsoundon 'SOUNDS inst = 82 vel = 68 oct = 3 LDMusic.Channel =2 LDMusic.Instrument = inst LDMusic.Velocity = vel note[2] = LDMusic.PlayNote(oct, "C", 2) LDMusic.Channel = 3 LDMusic.Instrument = inst LDMusic.Velocity = vel note[3] = LDMusic.PlayNote(oct, "E", 3) LDMusic.Channel = 4 LDMusic.Instrument = inst LDMusic.Velocity = vel note[4] = LDMusic.PlayNote(oct, "G", 4) LDMusic.Channel = 5 LDMusic.Instrument = inst LDMusic.Velocity = vel note[5] = LDMusic.PlayNote(oct, "A", 5) LD3DView.ModifyObject(view3d,tbeam,"S") LDTimer.Resume(onbeamtimer) EndSub Sub thrustersoundon 'SOUNDS If thrustsound <> "on" Then LDMusic.Channel = 1 LDMusic.Velocity = 128 LDMusic.Instrument = 127 note[1] = LDMusic.PlayNote(2,"G",1) EndIf thrusttime = 2000 thrusttime = thrusttime + 200 * speednum speednum = 0 LDTimer.Interval(thrusttimer,thrusttime) LDTimer.Resume(thrusttimer) thrustsound = "on" EndSub Sub thrustersoundoff 'SOUNDS LDMusic.EndNote(note[1]) LDTimer.Pause(thrusttimer) thrustsound = "off" EndSub Sub bumpsoundon 'SOUNDS LDMusic.Channel = 6 LDMusic.Velocity = 128 LDMusic.Instrument = 128 note[1] = LDMusic.PlayNote(3,"C",6) EndSub Sub tbeamcontrol 'TRACTOR BEAM DISPLAY bcampos = LD3DView.GetCameraPosition(view3d) bcamdir = LD3DView.GetCameraDirection(view3d) bcamup = LD3DView.GetCameraUpDirection(view3d) beamopos = LDVector.Subtract(bcampos,LDVector.Multiply(bcamup,2)) beamndpos = LDVector.Add(bcampos,LDVector.Multiply(bcamdir,coneh*1.3)) beamdir = LDVector.Normalise(LDVector.Subtract(beamopos,beamndpos)) beamcross = LDVector.CrossProduct(vy,beamdir) angle = LDVector.AngleBetween(beamdir,vy) LD3DView.TranslateGeometry(view3d,tbeam,beamndpos[1],beamndpos[2],beamndpos[3]) LD3DView.RotateGeometry3(view3d,tbeam,beamcross[1],beamcross[2],beamcross[3],angle) campos = LD3DView.GetCameraPosition(view3d) camdir = LD3DView.GetCameraDirection(view3d) tractorpos = LDVector.Add(campos,LDVector.Multiply(camdir, 13+speed)) LD3DView.AnimateTranslation(space,tractorhit[1],tractorpos[1],tractorpos[2],tractorpos[3],.001) LD3DView.AnimateTranslation(view3d,tractorhit[3],tractorpos[1],tractorpos[2],tractorpos[3],.001) parkguide() EndSub 'BUILD A CONE GEOMETRY Sub conegeometry' radius, div, height,color,material_type radius = args[1] div = args[2] tipalt[1] = 0 tipalt[2] = 0 tipalt[3] = -args[3]/2 basealt[1] = 0 basealt[2] = 0 basealt[3] = args[3]/2 points = tipalt[1]+":"+tipalt[2]+":"+tipalt[3]+":" conecolor = args[4] mtype = args[5] indices = "" textures = "0.5:1:" For i = 0 To div angle = i/div*360 x = LDMath.FixDecimal(radius*LDMath.Cos(-angle),2) y = LDMath.FixDecimal(radius*LDMath.Sin(-angle),2) points = points+x+":"+y+":"+basealt[3]+":" If tipalt[3] > basealt[3] Then If (i < div) Then indices = indices +(i+2)+":"+(i+1)+":"+"0:" Else indices = indices +1+":"+(i+1)+":"+"0:" EndIf Else If (i < div) Then indices = indices + "0:"+(i+1)+":"+(i+2)+":" Else indices = indices + "0:"+(i+1)+":"+1+":" EndIf EndIf textures = textures + i/div+":0:" EndFor return = LD3DView.AddGeometry(view3D,points,indices,"",conecolor,mtype) EndSub Sub createmotor 'BUILD ROCKET MOTOR GraphicsWindow.BrushColor = "White" engine[2] = LDCall.Function5("conegeometry",3,16,16,"Red","D") ' radius, div, height,color,material_type LD3DView.TranslateGeometry(view3d,engine[2],0,0,trailerlen/2 + 15) LD3DView.SetBackMaterial(view3d,engine[2],"Cyan","E") engine[3] = LDCall.Function5("conegeometry",2,16,-24,"#00FFFFFF","D") LD3DView.TranslateGeometry(view3d,engine[3],0,0,trailerlen/2 + 34) 'exhaust = ImageList.LoadImage(Program.Directory+"/exfs_exhaust.png") exhaust = ImageList.LoadImage("https://images2.imgbox.com/00/ff/mnXIgPBb_o.png") LD3DView.AddImage(view3d,engine[3],textures,exhaust,"E") LD3DView.SetBackMaterial(view3d,engine[3],"#00000000","D") engine[4] = LDCall.Function5("conegeometry",2.5,16,-30,"#00FFFFFF","D") LD3DView.TranslateGeometry(view3d,engine[4],0,0,trailerlen/2 + 37) LD3DView.AddImage(view3d,engine[4],textures,exhaust,"E") LD3DView.SetBackMaterial(view3d,engine[4],"#00000000","D") engine[5] = LDCall.Function5("conegeometry",3,16,-36,"#80FFFFFF","D") LD3DView.SetBackMaterial(view3d,engine[5],"#00000000","D") LD3DView.TranslateGeometry(view3d,engine[5],0,0,trailerlen/2 + 41) EndSub Sub createtrailerboundingbox 'NOT CURRENTLY USED gn1 = Text.GetSubTextToEnd(trailer,9) mm = LD3DView.BoundingBox(view3d,"Geometry"+gn1) For i = 1 To 3 mm[i] = mm[i+3] + mm[i] EndFor For gn = gn1 To gn1 + 9 Step 6 gname = "Geometry"+gn dat = LD3DView.BoundingBox(view3d,gname) For i = 1 To 3 dat[i] = dat[i+3] + dat[i] If dat[i] > mm[i] Then mm[i] = dat[i] EndIf If dat[i+3] < mm[i+3] Then mm[i+3] = dat[i+3] EndIf EndFor EndFor tubedata = "" For i = 1 To 6 tubedata = tubedata + mm[i]+":" EndFor tubdiag = LD3DView.AddTube(view3d,tubedata,.5,8,"White","E") trailerbb = LD3DView.AddCube(view3d,mm[1]-mm[4],"#40FF0000","E") LD3DView.ScaleGeometry(view3d,trailerbb,(mm[1]-mm[4])/(mm[1]-mm[4]),(mm[2]-mm[5])/(mm[1]-mm[4]),(mm[3]-mm[6])/(mm[1]-mm[4])) pos = LD3DView.GetPosition(view3d,tubdiag) LD3DView.TranslateGeometry(view3d,trailerbb,pos[1],pos[2],pos[3]) trailerbb1 = LD3DView.AddCube(space,mm[1]-mm[4],"#000000FF","E") LD3DView.ScaleGeometry(space,trailerbb1,(mm[1]-mm[4])/(mm[1]-mm[4]),(mm[2]-mm[5])/(mm[1]-mm[4]),(mm[3]-mm[6])/(mm[1]-mm[4])) LD3DView.TranslateGeometry(space,trailerbb1,pos[1],pos[2],pos[3]) LD3DView.TranslateGeometry(view3d,trailerbb,1000,1000,1000) LD3DView.ModifyObject(view3d,trailerbb,"H") LD3DView.ModifyObject(view3d,tubdiag,"H") EndSub Sub buildtrailercollisionframes ''GEOMETRY IN COLLISION SPACE AROUND TRANSPORT VEHICLE TO SIMULATE COLLISION WITH CONTAINER IN TRACTOR BEAM frame[1] = LD3DView.AddCube(space,3,"HotPink","E") LD3DView.ScaleGeometry(space,frame[1],1,1,32) For i = 2 To 4 frame[i] = LD3DView.CloneObject(space,frame[1]) EndFor d = 5.5 pos = LD3DView.GetPosition(space,centerball) LD3DView.TranslateGeometry(space,frame[1],pos[1]+d,pos[2]+d,pos[3]) LD3DView.TranslateGeometry(space,frame[2],pos[1]-d,pos[2]+d,pos[3]) LD3DView.TranslateGeometry(space,frame[3],pos[1]-d,pos[2]-d,pos[3]) LD3DView.TranslateGeometry(space,frame[4],pos[1]+d,pos[2]-d,pos[3]) EndSub Sub builddividers ''DIVIDERS BETWEEN SECTIONS OF TRANSPORT VEHICLE For size = 8 To 14 Step 6 tiles = 1 points = "" indices = "" textures = "" index = 0 For z = -48 To 40 Step 8 For i = 1 To tiles For j = 1 To tiles x1 = (i-1) * size - size/2 x2 = i * size/2 y1 = (j-1) * size - size/2 y2 = j * size/2 'Triangle1 points = points+x1+":"+y1+":"+z+":" points = points+x2+":"+y1+":"+z+":" points = points+x2+":"+y2+":"+z+":" indices = indices + index+":"+(index+1)+":"+(index+2)+":" index = index+3 textures = textures + "0 0:0 1:1 1:" 'Triangle2 points = points+x1+":"+y1+":"+z+":" points = points+x2+":"+y2+":"+z+":" points = points+x1+":"+y2+":"+z+":" indices = indices + index+":"+(index+1)+":"+(index+2)+":" index = index+3 textures = textures + "0 0:1 1:1 0:" EndFor EndFor EndFor If size = 8 Then dividers = LD3DView.AddGeometry(view3d,points,indices,"","#00FFFF","D") LD3DView.SetBackMaterial(view3d,dividers,"#00FFFF","D") ElseIf size = 14 then dividers1 = LD3DView.AddGeometry(space,points,indices,"","#00FFFF","E") LD3DView.SetBackMaterial(space,dividers1,"#00FFFF","E") EndIf EndFor EndSub Sub is_cube_in_spot 'CHECK IF CONTAINER IN TRACTOR BEAM IS POSITIONED PROPERLY IN TRANSPORT VEHICLE Sound.PlayClick() workingcube = args[1] cubepos = LD3DView.GetPosition(view3d,workingcube) mid = LD3DView.GetPosition(view3d,centerball) mid[3] = Math.Floor(cubepos[3] / 8) * 8 + 4 score = LDVector.Length(LDVector.Subtract(cubepos,mid)) If score > 1.25 Then return = "False" Else LDCall.Function("scoreit",1000 - 200 *score) return = "True" EndIf EndSub Sub scoreit ''SCORE ANIMATION score1 = Math.Round(args[1]) Shapes.Move(scorepop,gwc,ghc) Shapes.SetText(scorepop,score1) Shapes.Animate(scorepop,-200,-100,3000) subscore = subscore + score1 Shapes.SetText(subscorebox,subscore) EndSub Sub checktrailerload 'CHECKING TRANSPORT VEHICLE LOADOUT stored = 0 loadout = "" gn = Text.GetSubTextToEnd(cube[1],9) gn1 = Text.GetSubTextToEnd(cube1[25],9) For ii = gn To gn1 If geo_ani_state[ii] = "stored" Then stored = stored + 1 loadout[stored] = "Geometry" + ii EndIf EndFor Shapes.ShowShape(loadbox) Shapes.SetText(loadbox,stored/2 +" of 12 Containers Loaded") Shapes.Move(loadbox,gw*.1,gh*.8) Shapes.Animate(loadbox,gw+300,-200,8000) If stored > storefull Then mid = LD3DView.GetPosition(view3d,trailer) gn1 = Text.GetSubTextToEnd(trailer1,9) For gn = gn1 + xtras-2 To gn1 + xtras gname = "Geometry"+gn LD3DView.ModifyObject(view3d,gname,"S") EndFor angb = 1 For loadnum = 1 To Array.GetItemCount(loadout) 'ANIMATE LOAD MOVEMENT gname = loadout[loadnum] p1 = LD3DView.GetPosition(view3d,gname) p = LDVector.Subtract(mid,p1) p[2] = p[2] + 8000 LD3DView.SetCentre(view3d,gname, p[1],p[2],p[3],"R1R2R3") LD3DView.AnimateRotation(view3d,gname,1,0,0,0,angb,10,1) EndFor For gn = gn1 to gn1 + xtras 'ANIMATE TRAILER MOVEMENT gname = "Geometry" + gn p1 = LD3DView.GetPosition(view3d,gname) p = LDVector.Subtract(mid,p1) p[2] = p[2] + 8000 LD3DView.SetCentre(view3d,gname, p[1],p[2],p[3],"R1R2R3") LD3DView.AnimateRotation(view3d,gname,1,0,0,0,angb,10,1) endfor deliverynum = deliverynum + 1 If deliverynum = 2 Then 'MESSAGEING AT GAME END AFTER SECOND LOADOUT OF TRANSPORT VEHICLE Shapes.SetText(deliverymessagebox,"Second Delivery in Progress") Shapes.ShowShape(deliverymessagebox) Shapes.Move(deliverymessagebox,-gw*.1,gh*.8) Shapes.Animate(deliverymessagebox,gw+300,gh*.8,12000) finalscore = LDMath.FixDecimal((subscore - damageamt) * 20/eltime,0) finaltext = "Mission Complete"+crlf+"Score="+subscore+crlf+"Damage="+damagetot+crlf+"Elapsed Time="+eltime+crlf+"Final Score="+finalscore Shapes.SetText(finalbox,finaltext) Shapes.ShowShape(finalbox) Shapes.Move(finalbox,gw*1.2,gh) Shapes.Animate(finalbox,gw*.25,gh*.25,12000) LDTimer.Resume(endgametime) EndIf If deliverynum = 1 Then''MESSAGING AFTER FIRST LOADOUT OF TRANSPORT VEHICLE Shapes.ShowShape(deliverymessagebox) Shapes.Move(deliverymessagebox,-gw*.1,gh*.8) Shapes.Animate(deliverymessagebox,gw+300,gh*.8,12000) finalscore = LDMath.FixDecimal((subscore - damageamt),0) finaltext = "Move More Containers"+crlf+"Score="+subscore+crlf+"Damage="+damagetot+crlf+"Elapsed Time="+eltime+crlf+"Interim Score="+finalscore Shapes.SetText(finalbox,finaltext) Shapes.ShowShape(finalbox) Shapes.Move(finalbox,gw*1.2,gh) Shapes.Animate(finalbox,gw*.25,gh*.25,12000) LDTimer.Resume(endgametime) EndIf EndIf EndSub Sub check3nodes 'CHECK STATUS OF NODES threenodestate = 0 For nn = 1 To 3 If node[nn] = "True" Then threenodestate = threenodestate + 1 EndIf EndFor Shapes.SetText(nodesbox,"Nodes="+threenodestate) If threenodestate > 2 Then mousecursor = "True" Mouse.ShowCursor() LDControls.RichTextBoxSetText(rtb,interfacetext,"False") LDCall.Function3("wordmark","EXFS ORBITAL STOREHOUSE CONTROLLER INTERFACE","32,bold",0) LDControls.RadioButtonSet(exit1) For i = Text.GetSubTextToEnd(rtb,8) to Text.GetSubTextToEnd(exit1,8) Controls.ShowControl("Control"+i) endfor interfacepanelstate = "True" Mouse.MouseX = gw*.655 Mouse.MouseY = gh*.90 EndIf EndSub sub onanimaterotatecomplete 'HANDLING TRANSPORT VEHICLE ANIMATION MOVEMENT gn2 = Text.GetSubTextToEnd(trailer1,9) If LD3DView.LastRotationCompleted = "Geometry"+(gn2+xtras) Then If angb > 0 Then If angb > 260 Then angb = -1 For gn = gn2 + xtras-2 To gn2 + xtras gname = "Geometry"+gn LD3DView.ModifyObject(view3d,gname,"H") EndFor Else If angb <180 then anga = angb angb = anga * 2 For loadnum = 1 To Array.GetItemCount(loadout) gname = loadout[loadnum] LD3DView.AnimateRotation(view3d,gname,1,0,0,anga,angb,2,1) EndFor For gn = gn2 to gn2 + xtras 'ANIMATE TRAILER MOVEIN gname = "Geometry" + gn LD3DView.AnimateRotation(view3d,gname,1,0,0,anga,angb,2,1) endfor Else angb = 270 For loadnum = 1 To Array.GetItemCount(loadout) geo_ani_state[Text.GetSubTextToEnd(loadout[loadnum],9)] = "delivered" EndFor For gn = gn2 to gn2 + xtras 'ANIMATE TRAILER MOVEIN gname = "Geometry" + gn LD3DView.AnimateRotation(view3d,gname,1,0,0,340,360,10,1) endfor EndIf EndIf EndIf EndIf EndSub Sub messages 'MISSION MESSAGES msg = "Your Mission is to place all 24 containers into the Transport Vehicle. " msg = msg + ":The Rotating Container Cube is protected by a force field." msg = msg + ":Also a gravity field keeps the containers within the confines of the cube" msg = msg + ":You must first connect with all three nodes at the corners of the Container Cube. " msg = msg + ":Approach the Blue Nodes and stay within 18 units and centered on the node. " msg = msg + ":A Timer will indicate your connection progress." msg = msg + ":When approaching the Yellow Sphere node stay within the guide column. " msg = msg + ":You must be alligned in the guide column and centered on the blue cross-hairs. " msg = msg + ":When within 3 units of the blue cross hairs Auto Speed Control is engaged. " msg = msg + ":Match the rotational speed and hold until the connection is established. " msg = msg + ":After connecting all three nodes you will then have access to the Cube Control Panel. " msg = msg + ":The Transport Vehicle can hold 12 containers at a time. " msg = msg + ":When the Transport Vehicle bays are all full the Vehicle will Auto Deliver the cargo. " msg = msg + ":Continue retrieving containers and bring them near the Transport Vehicle area. " msg = msg + ":Until the Vehicle returns for the second load" msg = LDText.Split(msg,":") msgtot = Array.GetItemCount(msg) msgcount = 0 EndSub Sub missionbriefing messages() TextWindow.Title = "MISSION BRIEFING DO NOT CLOSE THIS WINDOW JUST MINIMIZE or press Alt Tab" For i = 1 To msgtot TextWindow.WriteLine(msg[i]) EndFor TextWindow.WriteLine(crlf+crlf+t4+"LOADING PLEASE WAIT") EndSub Sub setupkeyhelp 'KEYBOARD HELP MESSAGE msg1 = "EXOSPHEREIC FREIGHT SERVICE KEYBOARD MENU"+crlf msg1 = msg1 + t1+"Thruster Controls"+crlf msg1 = msg1 + "MOVE"+t1+"W-forward"+t1+"S-reverse"+t1+"X-stop"+crlf msg1 = msg1 + "YAW"+t1+"A-left"+t2+"D-right"+t2+"F-stop"+crlf msg1 = msg1 + "PITCH"+t1+"Z-up"+t2+"C-down"+t2+"V-stop"+crlf msg1 = msg1 + "ROLL"+t1+"Q-left"+t2+"E-right"+t2+"R-stop"+crlf msg1 = msg1 + "LEFT SHIFT"+t2+"all stop"+crlf msg1 = msg1 + "SPEED"+t3+"1 to 9"+t2+"0-stop"+crlf msg1 = msg1 + "_________________________________________________________________"+crlf msg1 = msg1 + "K"+t3+"Keyboard Menu"+crlf msg1 = msg1 + "O"+t3+"Interface Menu"+crlf msg1 = msg1 + "H"+t3+"Toggle Help Messages"+crlf msg1 = msg1 + "T"+t3+"Tractor Beam Off"+crlf msg1 = msg1 + "Esc"+t3+"Quit"+crlf msg1 = msg1 + "F1"+t3+"Credits"+crlf msg1 = msg1 + "Alt Tab" + t3 + "Mission Briefing"+crlf LDControls.RichTextBoxSetText(rtb,msg1,"False") LDCall.Function3("wordmark","EXOSPHEREIC FREIGHT SERVICE KEYBOARD MENU","32,bold",0) LDCall.Function3("wordmark","Thruster Controls","24,bold",0) Controls.ShowControl(rtb) EndSub Sub credits 'CREDITS MESSAGE msg1 = "EXFS Credits"+crlf msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "The Globe map by NOAA available for download at:"+crlf+"http://www.ngdc.noaa.gov/mgg/global/global.html"+crlf msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "LitDev SmallBasic Extension Version 1.2.20.0"+crlf+"http://litdev.co.uk/" msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "Microsoft Small Basic Version 1.2.0.0"+crlf+"https://smallbasic-publicwebsite.azurewebsites.net/"+crlf msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "imgbox Host JPG, GIF and PNG images"+crlf msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "Supported Operating System Windows 10 , Windows 7, Windows 8, Windows 8.1, Windows Vista"+crlf msg1 = msg1 + "_____________________________________________________________"+crlf msg1 = msg1 + "Program written by: cvmarus"+crlf+"Please use this game for learning Small Basic" LDControls.RichTextBoxSetText(rtb,msg1,"False") LDCall.Function3("wordmark","EXFS Credits","16,bold",0) Controls.ShowControl(rtb) EndSub End>QTN895.sb< Start>QTT267.sb< 'Show the Window ----------------------------- GraphicsWindow.Show() 'Create the Text above the Menu Button ---------------------------------- GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Arial" GraphicsWindow.FontSize = 12 MenuText = Shapes.AddText("Click the Menu Button and Open a Text File") Shapes.Move(MenuText,180,40) Shapes.ShowShape(MenuText) 'Create Menu Button ---------------------------------------------------------- Box1Color = GraphicsWindow.GetColorFromRGB(230,240,220) GraphicsWindow.BrushColor = Box1Color GraphicsWindow.PenWidth = 1 OpenButton = Shapes.AddRectangle(100,35) Shapes.Move(OpenButton,250,65) 'Create Menu Button Text ---------------------------------------------------- GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Verdana" GraphicsWindow.FontSize = 14 MenuText = Shapes.AddText("Menu") Shapes.Move(MenuText,280,73) Shapes.ShowShape(MenuText) 'Create a Text Box at StartUp -------------------------------------------------- tbox = FCControls.AddMultilineTextBox(590,300,"") FCControls.SetBorderColor(tbox,"black") FCControls.Move(tbox,10,100) 'Set-Up for MouseMove and MouseDown Events ---------------------------- GraphicsWindow.MouseMove = MouseEvent'RedrawButton GraphicsWindow.MouseDown = MouseEvent'RedrawButton 'MouseDown Events -------------------------------------------------------------- GraphicsWindow.MouseDown = OnMouseDown Click = 0 Num1 = 0 While("True") If(Click = 1) Then 'Make sure our Button has been Clicked. If(Num1 = 1) Then 'Make sure it hasn't been Clicked twice in a row. 'Create the Menu Box --------------------------------------- MenuColor = GraphicsWindow.GetColorFromRGB(245,255,205) GraphicsWindow.BrushColor = MenuColor GraphicsWindow.PenWidth = 1 Menu = Shapes.AddRectangle(150,200) Shapes.Move(Menu,225,100) 'Create Open File Text on the Menu ---------------------- GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Verdana" GraphicsWindow.FontSize = 14 OpenFileText = Shapes.AddText("Open File") Shapes.Move(OpenFileText,265,125) Click = 0 EndIf EndIf Program.Delay(20) 'Call Up Open File Dialog Box -------------------------------------------- If(Click = 2) Then loadfile = FCDialogs.AskForFile2(".txt") ' The following line could be harmful and has been automatically commented. ' contents = File.ReadContents(loadfile) tbox = FCControls.AddMultilineTextBox(590,300,contents) FCControls.SetBorderColor(tbox, "black") FCControls.Move(tbox,10,100) Shapes.Remove(Menu) Shapes.Remove(OpenFileText) Click = 0 Num1 = 0 EndIf Program.Delay(20) EndWhile 'These Mouse Down Events actually set-up the Events above -------------- Sub OnMouseDown mX = GraphicsWindow.MouseX mY = GraphicsWindow.MouseY '------------See if we've Clicked in the Right Area ------------- 'Menu Button ---------------------------------------------------------------------- If(mX > 250 And mX < 350 And mY > 65 And mY < 100) Then Click = 1 Num1= Num1+1 'This insures that our Button can only be used once 'and can't be Clicked twice in a row. EndIf 'Open File Button ----------------------------------------------------------------- If(mX > 225 And mX < 375 And mY >115 And mY < 150) Then Click = 2 EndIf EndSub 'MouseOver Events ---------------------------------------------------------- Sub MouseEvent x = GraphicsWindow.MouseX y = GraphicsWindow.MouseY 'Make the Menu Button Text Zoom on MouseOver ---------------------- If (x > 250 And x < 350 And y > 65 And y < 100) Then Shapes.Zoom(MenuText,1.3,1.3)'------------Zoom Else Shapes.Zoom(MenuText,1,1)'------------------Zoom EndIf 'Make the Open File Text Zoom on MouseOver --------------------------- If (x > 225 And x < 375 And y > 115 And y < 150) Then Shapes.Zoom(OpenFileText,1.5,1.5)'------Zoom Else Shapes.Zoom(OpenFileText,1,1)'------------Zoom EndIf 'If the Mouse isn't over the Menu Box then close it. ---------------------- If (x < 225 Or x > 375 Or y < 60 Or y > 300) Then Shapes.Remove(Menu) Shapes.Remove(OpenFileText) Num1 = 0 EndIf EndSub End>QTT267.sb< Start>QTT745.sb< 'All LD extension methods can be safely deleted - only used for gradient brushes nBall = 50 radius = 20 gravity = 0.05 elasticity = 0.95 friction = 0.01 freezeVel = 0.1 gw = 800 gh = 700 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.PenWidth = 0 GraphicsWindow.Left = (Desktop.Width-gw)/2 GraphicsWindow.Top = 0 GraphicsWindow.BackgroundColor = "Teal" LDGraphicsWindow.BackgroundBrush(LDShapes.BrushGradient("1=Teal;2=DarkBlue;","V")) GraphicsWindow.BrushColor = "Red" gradient = LDShapes.BrushGradient("1=Orange;2=Red;3=DarkRed;","R") For i = 1 To nBall ball[i] = Shapes.AddEllipse(2*radius,2*radius) posX[i] = radius + Math.GetRandomNumber(gw-2*radius) posY[i] = radius + Math.GetRandomNumber(gh-2*radius) velX[i] = Math.GetRandomNumber(11)-6 velY[i] = Math.GetRandomNumber(11)-6 LDShapes.BrushShape(ball[i],gradient) EndFor GraphicsWindow.MouseDown = OnMouseDown GraphicsWindow.KeyDown = OnKeyDown GraphicsWindow.KeyUp = OnKeyUp While ("True") start = Clock.ElapsedMilliseconds 'Mouse click If (mouseDown) Then mouseDown = "False" 'Handled For i = 1 To nBall dx = GraphicsWindow.MouseX-posX[i] dy = GraphicsWindow.MouseY-posY[i] dist = Math.SquareRoot(dx*dx + dy*dy) If (dist < radius) Then velY[i] = velY[i]-20 ' Up boost frozen[i] = 0 EndIf EndFor EndIf 'keys If (keys["Space"]) Then 'Stop For i = 1 To nBall frozen[i] = 1 velX[i] = 0 velY[i] = 0 EndFor ElseIf (keys["Q"]) Then 'start For i = 1 To nBall frozen[i] = 0 EndFor ElseIf (keys["Z"]) Then 'Jiggle For i = 1 To nBall frozen[i] = 0 velX[i] = (Math.GetRandomNumber(11)-6)/10 velY[i] = (Math.GetRandomNumber(11)-6)/10 EndFor ElseIf (keys["A"]) Then 'Jiggle Up For i = 1 To nBall frozen[i] = 0 velX[i] = velX[i]+(Math.GetRandomNumber(11)-6)/10 velY[i] = velY[i]+(-Math.GetRandomNumber(11))/10 EndFor EndIf For i = 1 To nBall 'Normal update position and wall bounces If (frozen[i] = 0) Then velX[i] = velX[i]*(1-friction) velY[i] = velY[i]*(1-friction) + gravity EndIf posX[i] = posX[i]+velX[i] posY[i] = posY[i]+velY[i] If (posX[i] < radius) Then velX[i] = -velX[i] * elasticity posX[i] = radius ElseIf (posX[i] > gw-radius) Then velX[i] = -velX[i] * elasticity posX[i] = gw-radius EndIf If (posY[i] < radius) Then velY[i] = -velY[i] * elasticity posY[i] = radius ElseIf (posY[i] > gh-radius) Then velY[i] = -velY[i] * elasticity posY[i] = gh-radius EndIf 'Do collisions For j = i+1 To nBall 'Only compare each ball others once dx = posX[j]-posX[i] dy = posY[j]-posY[i] dist = Math.SquareRoot(dx*dx + dy*dy) dist = Math.Max(dist,1) 'Prevent possible exact overlap (division by zero) If (dist < 2*radius) Then 'A hit 'Centre of mass (momentum) mX = (velX[j]+velX[i])/2 * elasticity mY = (velY[j]+velY[i])/2 * elasticity 'Velocities transformed to CM frame cX1 = velX[i]-mX cY1 = velY[i]-mY cX2 = velX[j]-mX cY2 = velY[j]-mY ''Unit vector from i to j dx = dx/dist dy = dy/dist 'Dot products n1 = cX1*dx+cY1*dy n2 = cX2*dx+cY2*dy 'Extra small push apart if balls significantly overlapping If (dist < 1.9*radius) Then n1 = n1+0.05 n2 = n2-0.05 EndIf 'Do bounce only if balls are moving towards each other (n1 > 0 & n2 < 0) 'Prevents weird internal double hits If (n1 > 0 And n2 < 0) Then cX1 = cX1-2*n1*dx cY1 = cY1-2*n1*dy cX2 = cX2-2*n2*dx cY2 = cY2-2*n2*dy 'Velocities transformed back to True Frame velX[i] = cX1+mX velY[i] = cY1+mY velX[j] = cX2+mX velY[j] = cY2+mY 'Counter gravity on upper ball when hit to prevent collapsing when packing If (posY[i] < posY[j]) Then velY[i] = velY[i]-gravity Else velY[j] = velY[j]-gravity EndIf EndIf 'Freeze if stationary speed1 = Math.SquareRoot(velX[i]*velX[i]+velY[i]*velY[i]) speed2 = Math.SquareRoot(velX[j]*velX[j]+velY[j]*velY[j]) If (speed1 < freezeVel And speed2 < freezeVel And dist > 1.95*radius) Then frozen[i] = 1 frozen[j] = 1 velX[i] = 0 velY[i] = 0 velX[j] = 0 velY[j] = 0 Else frozen[i] = 0 frozen[j] = 0 EndIf EndIf EndFor 'Update positions Shapes.Move(ball[i],posX[i]-radius,posY[i]-radius) EndFor delay = 20-(Clock.ElapsedMilliseconds-start) GraphicsWindow.Title = Math.Round(1000/Math.Max(20,(20-delay)))+" fps" If (delay > 0) Then Program.Delay(delay) EndIf EndWhile Sub OnMouseDown mouseDown = "True" EndSub Sub OnKeyDown key = GraphicsWindow.LastKey keys[key] = "True" EndSub Sub OnKeyUp key = GraphicsWindow.LastKey keys[key] = "" EndSub End>QTT745.sb< Start>QTX388.sb< Sub init clrs=LDText.Split("blue #fe0000 magenta green cyan yellow white SaddleBrown DarkSlateGray teal tan" " ") clrs[0]="black cc[ 1]="..####.. ##### . #### . #### .######. ###### .$#####. #### .#$ @# #### #$ @# $# #### @#### ###### #######. #$ # @# # # #$ #@ .#####...#####...#$ @# .#$ @#.@# $#.#$ #@.##### . ##$ #### #### #### ###### #### #### #### ###### # # # # # # # ## #### ############ ######## ######## cc[ 2]=".#$ @#. #$ @# .#$ @#. #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ @# #$ @# $# #$ @# $# #$ $# . #$ ## @# ## ## #$ #@ .#$ @#..#$ @#..#$ @# .#$ @# @# $# #$ #@ # #. # #$ # $# #$ @# #@ $# #$ #$ #@ $# #$ ## # ## # # # # ##### # # # # # # # # # ############ ######## ######## cc[ 3]=".#$ @#. ##### .#$ . #$ @# .##### . ##### . $# . #$ $# .#$ @# #$ ###### $# #### @# $# #$ $# . #$ #$# @# #$##@# ###@ .#$ @#..#$ @#..#$ @# .#$ @# @## #$#@ # ### #. #$ $# #### #@ $# ##### ##### ## #$ #@# # # # # ###### # # # # # # # # # # # # # # ############ ######## ######## cc[ 4]=".######. #$ @# .#$ . #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ ### #$ @# #@ $# $# @# # $# #$ $# . #$ #@$#@# #$ @# #$$# .##### ..##### ..#$ @# .#$ @# $## #$ # # #. #$ #### #$ @# ##### $# #$ @# $# #$# @# # # # # ##### ##### ##### # # # ## ####### ############ ######## ######## cc[ 5]=".#$ @#. #$ @# .#$ @#. #$ @# .#$ . #$ . $# . #$ $# .#$ @# #$ @# #$ @# #@ $# #$ $# @# #$# #$ $# . #$ #@ $## #$ @# #$ $# .#$ ..#$ @# .. #$@# .#$##@# $# @# #$ # ### #. #$ #$ #$ @# $# #@ $# #$ @# #@ $# ## @# # ###### # ###### # # # # # # # # # # # #### #### ################ #### cc[ 6]=".#$ @#. ##### . #### . #### .######. #$ .$#####. #### . #### #### #$ @# #### #### @#### ###### $# . ###### #@ $# #$ @# #$ $# .#$ ..#$ @#.. ## . # # $# @# #$ # #. #####$. ######. #### @#### #### #### #### #### # # # . # # ##### # # # # # #### #### ################ #### cc[ 7]=".................................................................................................................................................................................................................##### .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. # .. .. # .# .. # .. # .. .. # .. .#### .#### .################ .####. .. .. . # # # # # # cc[ 8]="................................................................................................................................................................................................................. #### #### ################ #### cc[ 9]="................................................................................................................................................................................................................. cc[10]=" ..##. . ### . ## . ### .#### . #### . # . ## .# # ### # # # ### ## #### ##### # # # # # # # . ###. ..###.. # # .# # .# # .# # cc[11]=" .# # . # # .# # . # # .# . # . # . # # .# # # # # # # # # # # . # ## # ## ## # # . # # ..# #. # # .# # # # # # cc[12]=" .#### . ### .# . # # .### . ### . # . # # .# # # ## #### # ## # # # # . # # ## # # # ## . ### ..### . # # .# # # # cc[13]=" .# # . # # .# # . # # .# . # . # . # # .# # # # # # # # # # ## # # . # # # # # # # . # ..# # . # # .# # # # # # cc[14]=" .# # . ### . ## . ### .#### . # . # . ## . ## ### # # ## ### # # #### # . #### # # # # # # . # ..# #. # . # # # # # oppc="blue GraphicsWindow.PenWidth=0 GraphicsWindow.BackgroundColor="DarkSlateGray GraphicsWindow.BrushColor="darkblue GraphicsWindow.Width=1460 GraphicsWindow.Height=940 GraphicsWindow.Top=5 GraphicsWindow.Title="ZX Editor LDUtilities.ShowErrors="false not="true=false;false=true ix="ABCDEFIOUGHJSQZTLNMKPRVWXY[1289563074>=+-:,`$/()^?*!@#&% " mcm=LDText.Split("BORDER PAPER INK CLS NEW SAVE LOAD RUN LIST LET PERT PLOT DRAW INPUT PRINT Goto DATA READ RESTORE RANDOMIZE CLEAR For NEXT If Then INKEY$ AT " " ") MHH=LDText.Split("bb pp ii cl nw sv ld rn ls lt pt pl dr in pr go dd rd rs rz cr ff nx If th ik at " " ") For x=1 To Array.GetItemCount(mhh) mc[mhh[x]]=mcm[x] cmc[mhh[x]]=Text.GetCharacter(170+x) EndFor args=0 shh[0]=LDText.Split("8 7 6 5 4 3 2 1" " ") shh[1]=LDText.Split("1 2 3 4 5 6 7 8" " ") shh[2]=LDText.Split("2 4 1 8 6 7 5 3" " ") shh[3]=LDText.Split("3 8 2 7 1 5 4 6" " ") shh[4]=LDText.Split("5 1 8 2 3 4 6 7" " ") bl="# chm=ldtext.Split("A S D F G H J K L Q W E R T Y U I O P Z X C V B N M 0 1 2 3 4 5 6 7 8 9 + = > - : , ` $ / ( ) ^ ? * ! @ # & % [" " ") ppc="DarkSlateGray chm[57]=" " initt="true mchr() EndSub Sub mchr qdd=0 For h=1 To 57 If h>=51 Then qdd=1 EndIf thh=chm[h] If initt Then LDCall.Function2("gench" thh qdd) LDCall.Function("gencb" thh) If h<27 Then LDCall.Function("gencm" thh) EndIf jj[thh]=LDImage.Copy(ii[thh]) LDImage.ReplaceColour(ii[thh] oppc "black" 5) LDImage.ReplaceColour(ii[thh] "red" "white" 5) LDImage.ReplaceColour(kk[thh] oppc ppc 5) LDImage.ReplaceColour(kk[thh] "red" "lime" 5) EndIf LDImage.ReplaceColour(jj[thh] oppc ppc 5) LDImage.ReplaceColour(jj[thh] "red" "black" 5) LDImage.ReplaceColour(im[thh] oppc ppc 5) LDImage.ReplaceColour(im[thh] "red" "black" 5) EndFor oppc=ppc initt="false EndSub Sub begin init() GraphicsWindow.KeyDown=kkk ss=1 ttw="1=1;2=3;3=4 LDCall.Function5("print2" 1 22 "[1982 SINCLAIR RESEARCH LTD " "teal" "2333322222222224444444444444444444444") Program.Delay(1333) GraphicsWindow.Clear() ppc="teal EndSub bgg: nww="false begin() ppc=clrs[9] mmr[10]=cmc["pr"]+"`HELLO To ZX fans world` 'mmr[20]=cmc["lt"]+"B=2:"+cmc["lt"]+"C=3,14159" 'mmr[30]=cmc["pr"]+"A+B-C/D*a^b lll: GraphicsWindow.BrushColor=ppc GraphicsWindow.FillRectangle(0 0 1700 1100) ql=0 Timer.Tick=tttm Timer.Interval=150 Timer.Pause() For qq=1 To 300 If Text.StartsWith(mmr[qq] ":") Then mmr[qq]=Text.GetSubTextToEnd(mmr[qq] 2) EndIf If Array.ContainsIndex(mmr qq) Then cml=mmr[qq] dcln() clf=text.append(text.GetSubText("2222222222" 1 Text.GetLength(qq)+1) clf) ' TextWindow.WriteLine(clf) LDCall.Function5("print2" 1 ql qq+" "+cln "teal" clf) ql=ql+1 EndIf EndFor kyy="false cml="" While "true LDCall.Function5("print" 1 22 "K" "teal" 1) Program.Delay(455) LDCall.Function5("print" 1 22 "K" "teal" 2) Program.Delay(455) If kyy Then Goto ccf EndIf EndWhile ccf: cml="" LDCall.Function5("print" 1 22 " " ppc 2) fx=fx-1 rw=22 mode=1 '-------------------------------------------main loop------------------------------------------------- Timer.Resume() Sub tttm If kyy Then mmd=Text.GetSubText("KLCEG" mode 1) dcln() LDCall.Function5("print" 1 22 " " ppc 2) fx=1 LDCall.Function5("print" fx rw cln ppc 2) LDCall.Function5("print" fx rw mmd ppc 1) 'kyy="false EndIf EndSub While "true If brk Then Goto xxx EndIf If nww Then GraphicsWindow.Clear() GraphicsWindow.BrushColor="black GraphicsWindow.FillRectangle(50 50 1280 720) Program.Delay(555) GraphicsWindow.Clear() Program.Delay(555) Goto bgg EndIf If lstt Then lstt="false Goto lll EndIf If evv Then evv="false evlcml() LDCall.Function5("print" 1 22 "0 OK 0:1 " ppc 2) fx=1 dcc="true cml="" mode=1 EndIf EndWhile'---------------------------------------------------------------------------------------endmainloop xxx: GraphicsWindow.Clear() brk="false LDCall.Function5("print" 1 22 "D BREAK 0:1" ppc 2) Program.Delay(1377) GraphicsWindow.Clear() LDCall.Function5("print" 1 22 "LIST" ppc 2) LDCall.Function5("print" 6 22 "L" ppc 1) Program.Delay(1377) GraphicsWindow.Clear() Goto lll Sub kkk'--------------------------------*********************--KEYS ll=text.ConvertToLowerCase( GraphicsWindow.LastKey) 'GraphicsWindow.Title=ll kyy="true If ll="right" Then iss=iss+1 ElseIf ll="left" Then iss=iss-1 ElseIf ll="escape" Then brk="true extt="true ElseIf TEXT.StartsWith( ll "ret" ) Then If Text.StartsWith(cml ":") Then cml=Text.GetSubTextToEnd(cml 2) EndIf 'TextWindow.WriteLine(">"+cml) li=LDText.Split(cml ":") ln=text.GetSubTextToEnd (ldtext.Trim (li[1]) 2) lnm=LDUtilities.IsNumber(ln) 'TextWindow.WriteLine("?>"+ln) If not[lnm] Then ' tl=FCDialogs.AskForTextLine("To Line:") ' If tl="" Then evv="true ' Else ' mmr[tl]=cml ' cml="" ' lstt="true ' EndIf Else mmr[ln]="" For rr=2 To Array.GetItemCount(li) mmr[ln]=text.append(mmr[ln] ":"+li[rr]) EndFor ' TextWindow.WriteLine(">:"+mmr[ln]) lstt="true cml="" EndIf ElseIf ll="back" Then chp="" cml=Text.GetSubText(cml 1 Text.GetLength(cml)-1) GraphicsWindow.Title=cml If Text.GetLength(cml)<=1 Then mode=1 EndIf ElseIf ll="space" Then cml=cml+" " ElseIf ll="f1" Then mode=1 chp="" ElseIf ll="f2" Then mode=2 chp="" ElseIf ll="f3" Then chp="` cml=text.append(cml chp) ElseIf ll="f4" Then chp="$ cml=text.append(cml chp) ElseIf ll="f5" Then chp="! cml=text.append(cml chp) ElseIf ll="f6" Then chp="^ cml=text.append(cml chp) ElseIf ll="f7" Then chp="; cml=text.append(cml chp) ElseIf ll="f8" Then chp="* cml=text.append(cml chp) ElseIf ll="f9" Then chp="( cml=text.append(cml chp) ElseIf ll="f11" Then chp=") cml=text.append(cml chp) ElseIf ll="oem5" Then chp="? cml=text.append(cml chp) ElseIf ll="oemopenbrackets" Then chp="@ cml=text.append(cml chp) ElseIf ll="oem6" Then chp="% cml=text.append(cml chp) ElseIf ll="oem1" Then chp="& cml=text.append(cml chp) ElseIf ll="oemquotes" Then chp="# cml=text.append(cml chp) ElseIf ll="oemplus" Then chp="= cml=text.append(cml chp) ElseIf Text.GetLength(ll)=2 Then chp=Text.GetSubTextToEnd(ll 2) cml=text.append(cml chp) Else chp="" If mode=1 Then If ll="b" Then ' chp="BORDER " cml=cml+":"+cmc["bb"] mode=2 ElseIf ll="p" Then ' chp="PAPER " cml=cml+":"+cmc["pp"] mode=2 ElseIf ll="z" Then ' chp="per.table cml=cml+":"+cmc["pt"] mode=2 ElseIf ll="i" Then ' chp="INK " cml=cml+":"+cmc["ii"] mode=2 ElseIf ll="c" Then ' chp="CLS" cml=cml+":"+cmc["cl"] mode=2 ElseIf ll="f" Then ' chp="For cml=cml+":"+cmc["ff"] mode=2 ElseIf ll="g" Then ' chp="Goto cml=cml+":"+cmc["go"] mode=2 ElseIf ll="a" Then ' chp="NEW" cml=cml+":"+cmc["nw"] mode=2 ElseIf ll="r" Then ' chp="RUN " cml=cml+":"+cmc["rn"] mode=2 ElseIf ll="k" Then ' chp="Let cml=cml+":"+cmc["lt"] mode=2 ElseIf ll="q" Then ' chp="input cml=cml+":"+cmc["in"] mode=2 ElseIf ll="k" Then ' chp="let cml=cml+":"+cmc["lt"] mode=2 ElseIf ll="w" Then ' chp="print mode=2 cml=cml+":"+cmc["pr"] ElseIf ll="e" Then ' chp="at cml=cml+":"+cmc["at"] mode=2 ElseIf ll="l" Then ' chp="LIST " cml=cml+":"+cmc["ls"] mode=2 ElseIf ll="s" Then ' chp="SAVE " cml=cml+":"+cmc["sv"] mode=2 ElseIf ll="j" Then ' chp="Load cml=cml+":"+cmc["ld"] mode=2 EndIf Else chp=text.GetSubText( ll 1 1) If ll="oem1" Then chp=":" mode=1 EndIf If Text.GetLength(ll)=1 Then cml=cml+chp EndIf EndIf EndIf ' GraphicsWindow.Title=cml EndSub'------------------------------------------------------****** Sub dcln txl=LDText.Split(cml ":") cln="" clf="" For wt=1 To Array.GetItemCount(txl) cs=text.GetCharacterCode( Text.GetSubText(txl[wt] 1 1))-170 s2=Text.GetSubTextToEnd(txl[wt] 2) lls=Text.GetLength(mc[mhh[cs]]) ll1=Text.GetLength(s2) cln=cln+mc[mhh[cs]]+" "+s2+":" clf=text.append(clf Text.GetSubText("333333333333333333333333333333333333333333" 1 lls)) clf=text.append(clf Text.GetSubText("22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222" 1 ll1+2)) EndFor cln=Text.GetSubText(cln 1 Text.GetLength(cln)-1) ' TextWindow.WriteLine(clf) EndSub Sub pertbl Timer.Pause() elo="hhh;hel;lll;bry;bbb;ccc;nnn;ooo;fff;neo;nam;mgs;alm;sil;ppp;sss;chn;agn;kkk;clu;scd;tin;vvv;chr;mmm;frr;cob;nck;cpp;zzz;ggg;ger;asm;sen;bmn;kry;rbd;soc;yyy;zrn;nib;moy;ttt;rnm;rrr;pad;arg;cdd;inm;stn;sbm;tlr;iii;xxx;cae;bar;lan;cer;pdy;ndy;pmh;sar;eee;gdn;ter;dys;hlm;erb;tul;yrb;lue;hfn;tan;www;rhe;osm;ird;pat;aaa;hgr;tlm;plb;bsm;pol;att;ron;fnc;rau;act;tho;pra;uuu;npt;ptu;amc;cim;bkl;cfn;eis;fum;mdl;nbl;lwc;rtf;ddd;srg;boh;hss;met;dst;rgn;cpm;nhu;fve;msc;lvm;tss;ogn ell=LDText.Split(elo ";") ss="Ac act Actin# 90 270!Ar agn Argon 510 60!Al alm Alumin# 360 60!Am amc Americ# 270 270!Ag arg Silver 300 120!As asm Arsenic 420 90!At att Astatine 480 150!Au aaa Gold 300 150!Ba bar Bar# 30 150!Bk bkl Berkel# 330 270!Br bmn Bromine 480 90!Bh boh Bohr# 180 180!B bbb Boron 360 30!Be bry Beryll# 30 30!Bi bsm Bismuth 420 150!Cs cae Caes# 0 150!Cd cdd Cadm# 330 120!Ce cer Cer# 120 240!Cf cfn Californ# 360 270!Cl chn Chlorine 480 60!Cr chr Chrom# 150 90!Cm cim Cur# 300 270!Ca clu Calc# 30 90!Co cob Cobalt 240 90!Cn cpm Copernic# 330 180!Cu cpp Copper 300 90!C ccc Carbon 390 30!Db ddd Dubn# 120 180!Ds dst Darmstadt# 270 180!Dy dys Dyspros# 360 240!Es eis Einstein# 390 270!Er erb Erb# 420 240!Eu eee Europ# 270 240!F fff Fluorine 480 30!Fr fnc Franc# 0 180!Fe frr Iron 210 90!Fm fum Ferm# 420 270!Fl fve Flerov# 390 180!Ga ggg Gall# 360 90!Gd gdn Gadolin# 300 240!Ge ger German# 390 90!He hel Hel# 510 0!Hf hfn Hafn# 90 150!Hg hgr Mercury 330 150!Ho hlm Holm# 390 240!Hs hss Hass# 210 180!H hhh Hydrogen 0 0!In inm Ind# 360 120!I iii Iodine 480 120!Ir ird Irid# 240 150!K kkk Potass# 0 90!Kr kry Krypton 510 90!$= ltd ltds 60 240!*= atd actds 60 270!La lan Lanthanum 90 240!Li lll Lith# 0 30!Lu lue Lutet# 510 240!Lv lvm Livermor# 450 180!Lr lwc Lawrenc# 510 270!Md mdl Mendelev# 450 270!Mt met Meitner# 240 180!Mg mgs Magnes# 30 60!Mn mmm Manganese 180 90!Mo moy Molybdenum 150 120!Mc msc Moscov# 420 180!Na nam Sod# 0 60!No nbl Nobel# 480 270!Ni nck Nickel 270 90!Nd ndy Neodym# 180 240!Ne neo Neon 510 30!Nh nhu Nihon# 360 180!Nb nib Niob# 120 120!Np npt Neptun# 210 270!N nnn Nitrogen 420 30!Og ogn Oganesson 510 180!Os osm Osm# 210 150!O ooo Oxygen 450 30!Pd pad Pallad# 270 120!Pt pat Platinum 270 150!Pr pdy Praseodym# 150 240!P ppp Phosphorus 420 60!Pb plb Lead 390 150!Pm pmh Prometh# 210 240!Po pol Polon# 450 150!Pa pra Protactin# 150 270!Pu ptu Pluton# 240 270!Ra rau Rad# 30 180!Rb rbd Rubid# 0 120!Rh rrr Rhod# 240 120!Rg rgn Roentgen# 300 180!Re rhe Rhen# 180 150!Ru rnm Ruthen# 210 120!Rn ron Radon 510 150!Rf rtf Rutherford# 90 180!Sm sar Samar# 240 240!Sb sbm Antimony 420 120!Sc scd Scand# 60 90!Se sen Selen# 450 90!Si sil Silicon 390 60!Sr soc Stront# 30 120!Sg srg Seaborg# 150 180!Sn stn Tin 390 120!S sss Sulfur 450 60!Ta tan Tantalum 120 150!Ts tss Tennessine 480 180!Tb ter Terb# 330 240!Tc ttt Technet# 180 120!Th tho Thor# 120 270!Tl tlm Thall# 360 150!Te tlr Tellur# 450 120!Ti tin Titan# 90 90!Tm tul Thul# 450 240!U uuu Uran# 180 270!V vvv Vanad# 120 90!W www Tungsten 150 150!Xe xxx Xenon 510 120!Yb yrb Ytterb# 480 240!Y yyy Yttr# 60 120!$$ lnd Lantanoides 60 150!** acd Actinoides 60 180!Zn zzz Zinc 330 90!Zr zrn Zircon# 90 120! ss=LDText.Replace(ss "#" "ium") mm=LDText.Split(ss "!") For qf=1 To 122 lmm=LDText.Split(mm[qf] " ") LDCall.Function3("addb" text.GetSubText(lmm[1]+" " 1 2) lmm[4] lmm[5] ) 'LDCall.Function3("addb1" LDArray.GetIndex(ell lmm[2]) lmm[4] lmm[5]) EndFor extt="false While extt="false If kyy Then kyy="false GraphicsWindow.Clear() For qf=1 To 122 lmm=LDText.Split(mm[qf] " ") LDCall.Function3("addb" text.GetSubText(lmm[1]+" " 1 2) lmm[4] lmm[5] ) 'LDCall.Function3("addb1" LDArray.GetIndex(ell lmm[2]) lmm[4] lmm[5]) EndFor lmm=LDText.Split(mm[iss] " ") LDCall.Function3("addb1" text.GetSubText(lmm[1]+" " 1 2) lmm[4] lmm[5] ) GraphicsWindow.Title="("+lmm[1]+")"+LDArray.GetIndex(ell lmm[2])+" "+lmm[3]+" : "+lmm[2] EndIf EndWhile lstt="true Timer.Resume() EndSub Sub addb px=args[2]/30 py=args[3]/15 LDCall.Function5("print" px*2 py args[1] ppc math.Remainder(px 2)+1) EndSub Sub addb1 px=args[2]/30 py=args[3]/15 LDCall.Function5("print" px*2 py args[1] ppc 3) EndSub Sub evlcml cx=LDText.Split(cml ":") For lx=1 To Array.GetItemCount(cx) ee=cx[lx] If Text.StartsWith(ee cmc["pp"]) Then tt=Text.GetSubText(ee 2 1) ppc=clrs[ldmath.Base2Decimal( tt 16)] ' GraphicsWindow.Title=ppc mchr() ElseIf Text.StartsWith(ee cmc["nw"]) Then nww="true mmr="" Timer.Pause() ElseIf Text.StartsWith(ee cmc["pt"]) Then GraphicsWindow.Clear() pertbl() ElseIf Text.StartsWith(ee cmc["cl"]) Then GraphicsWindow.Clear() lstt="true ElseIf Text.StartsWith(ee cmc["in"]) Then vv=LDText.Split(ee " ") 'TextWindow.WriteLine(vv) vrr[text.GetSubTextToEnd( vv[1] 2)]=FCDialogs.AskForTextLine(vv[2]) ElseIf Text.StartsWith(ee cmc["sv"]) Then ff=LDDialogs.SaveFile("zx" "e:\") ' The following line could be harmful and has been automatically commented. ' File.WriteContents(ff mmr) ElseIf Text.StartsWith(ee cmc["ld"]) Then ff=LDDialogs.OpenFile ("zx" "e:\") ' The following line could be harmful and has been automatically commented. ' mmr=File.ReadContents(ff) lstt="true ElseIf Text.StartsWith(ee cmc["ls"]) Then lstt="true ElseIf Text.StartsWith(ee cmc["bb"]) Then tt=text.ConvertToLowerCase( Text.GetSubText(ee 2 1)) ' GraphicsWindow.Title=ee tt=ldmath.Base2Decimal( tt 16) bc=clrs[tt] GraphicsWindow.BrushColor=bc GraphicsWindow.FillRectangle(0 0 1600 80) GraphicsWindow.FillRectangle(0 850 1600 500) GraphicsWindow.FillRectangle(0 0 80 1000) GraphicsWindow.FillRectangle(1370 0 800 1000) EndIf EndFor EndSub Sub print2 fx=args[1] yy=args[2] tt=args[3] ccc=args[4] c1s=args[5] tu=tt' Text.ConvertToUpperCase(tt) For f=1 To Text.GetLength(tt) qw=text.GetSubText(tu f 1) c1=text.GetSubText(c1s f 1) If c1=2 Then jm=jj[qw] ElseIf c1=3 Then jm=kk[qw] ElseIf c1=4 Then jm=im[qw] Else jm=ii[qw] EndIf GraphicsWindow.DrawImage(jm fx*32+50 50+yy*32) fx=fx+1 If fx>40 Then fx=2 yy=yy+1 EndIf EndFor EndSub Sub print fx=args[1] yy=args[2] tt=args[3] ccc=args[4] c1=args[5] tu=tt' Text.ConvertToUpperCase(tt) For f=1 To Text.GetLength(tt) qw=text.GetSubText(tu f 1) If c1=2 Then jm=jj[qw] ElseIf c1=3 Then jm=kk[qw] ElseIf c1=4 Then jm=im[qw] Else jm=ii[qw] EndIf GraphicsWindow.DrawImage(jm fx*32+50 50+yy*32) fx=fx+1 If fx>40 Then fx=2 yy=yy+1 EndIf EndFor EndSub Sub gencm ch=args[1] GraphicsWindow.BrushColor="blue GraphicsWindow.PenWidth=0 ss=shapes.AddRectangle (32 32) gg=FCDrawings.CreateGraphicsFromControl(ss) qw=Text.GetIndexOf(ix ch)-1 For x=0 To 7 For y=0 To 7 n=x+8*qw+1 If Text.IsSubText (bl text.getSubText(cc[y+8] n 1)) Then lx=x*4 ly=y*4 FCDrawings.FillRectangle(gg "red" lx ly 4 4) EndIf EndFor EndFor im[ch]=FCDrawings.GenerateImage(gg) Shapes.Remove(ss) EndSub Sub gench ch=args[1] qd=args[2] GraphicsWindow.BrushColor="blue GraphicsWindow.PenWidth=0 ss=shapes.AddRectangle (32 32) gg=FCDrawings.CreateGraphicsFromControl(ss) qw=Text.GetIndexOf(ix ch)-1 For x=0 To 7 For y=0 To 7 n=x+8*qw+1 If Text.IsSubText (bl text.getSubText(cc[y+qd] n 1)) Then lx=x*4 ly=y*4 FCDrawings.FillRectangle(gg "red" lx ly 4 4) EndIf EndFor EndFor ' GraphicsWindow.Title=ch mg=FCDrawings.GenerateImage(gg) ii[ch]=mg thh=ch 'Shapes.AddImage(mg) 'Program.Delay(155) Shapes.Remove(ss) EndSub Sub gencb ch=args[1] GraphicsWindow.BrushColor="blue GraphicsWindow.PenWidth=0 ss=shapes.AddRectangle (32 32) gg=FCDrawings.CreateGraphicsFromControl(ss) qw=Text.GetIndexOf(ix ch)-1 For x=0 To 7 For y=0 To 7 n=x+8*qw+1 If Text.IsSubText ("#$@" text.getSubText(cc[y] n 1)) Then lx=x*4 ly=y*4 FCDrawings.FillRectangle(gg "red" lx ly 4 4) EndIf EndFor EndFor kk[ch]=FCDrawings.GenerateImage(gg) thh=ch Shapes.Remove(ss) EndSub End>QTX388.sb< Start>QVB169.sb< n = 9 For r = 1 To 7 For c = 1 To 7 num[r][c] = n n = n + 1 EndFor EndFor Count = 2 For Next = 1 To 8 TextWindow.Write(next+":") p = 1 TextWindow.Write(p+"-") For pic = 1 To 7 TextWindow.Write(count+"-") Count = Count + 1 EndFor TextWindow.WriteLine("") EndFor c = 1 For Next = 9 To 15 p = 2 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 0 EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 16 To 22 p = 3 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 1 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 23 To 29 p = 4 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 2 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 30 To 36 p = 5 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 3 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 37 To 43 p = 6 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 4 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 44 To 50 p = 7 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 5 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor c = 1 For Next = 51 To 57 p = 8 TextWindow.Write(next+":") TextWindow.Write(p+"-") r = 1 For pic = 1 To 7 TextWindow.Write(num[r][c]+"-") r = r + 1 c = c + 6 If c > 7 Then c = c - 7 endif EndFor c = c + 1 TextWindow.WriteLine("") EndFor End>QVB169.sb< Start>QVC538-0.sb< P1 = ImageList.LoadImage("http://www.xnadevelopment.com/sprites/thumbs/thumb_SharkGuy1.png") P2 = ImageList.LoadImage("http://www.xnadevelopment.com/sprites/thumbs/thumb_SharkGuy2.png") S1 = Shapes.AddImage(P1) S2 = Shapes.AddImage(P2) Shapes.HideShape(S2) GraphicsWindow.Width = Desktop.Width-17 GraphicsWindow.Height = Desktop.Height-75 GraphicsWindow.Title = "Shark" GraphicsWindow.Left = .5 GraphicsWindow.Top = .5 LastFace = "D" Timer.Interval = 355 int = 0 Timer.Tick = Control Sub Control int = int + 15 If(Math.Remainder(Int, 10) = 0)Then Shapes.HideShape(S2) Shapes.ShowShape(S1) Show = "S1" Else Shapes.HideShape(S1) Shapes.ShowShape(S2) Show = "S2" EndIf K = GraphicsWindow.LastKey If(K = "Right")Then Facing = "D" Shapes.Rotate(S1, 0) Shapes.Rotate(S2, 0) Shapes.Move(S1, Shapes.GetLeft(S1)+50 Shapes.GetTop(S1)) Shapes.Move(S2, Shapes.GetLeft(S2)+50Shapes.GetTop(S2)) ElseIf(K = "Down")Then Facing = "S" Shapes.Rotate(S1, 90) Shapes.Rotate(S2, 90) Shapes.Move(S1, Shapes.GetLeft(S1) Shapes.GetTop(S1)+50) Shapes.Move(S2, Shapes.GetLeft(S2) Shapes.GetTop(S2)+50) ElseIf(K = "Left")Then Facing = "A" Shapes.Rotate(S1, 180) Shapes.Rotate(S2, 180) Shapes.Move(S1, Shapes.GetLeft(S1)-50 Shapes.GetTop(S1)) Shapes.Move(S2, Shapes.GetLeft(S2)-50 Shapes.GetTop(S2)) ElseIf(K = "Up")Then Facing = "W" Shapes.Rotate(S1, 270) Shapes.Rotate(S2, 270) Shapes.Move(S1, Shapes.GetLeft(S1) Shapes.GetTop(S1)-50) Shapes.Move(S2, Shapes.GetLeft(S2) Shapes.GetTop(S2)-50) EndIf LastFace = Facing endSub End>QVC538-0.sb< Start>QVC538.sb< P1 = ImageList.LoadImage("http://www.xnadevelopment.com/sprites/thumbs/thumb_SharkGuy1.png") P2 = ImageList.LoadImage("http://www.xnadevelopment.com/sprites/thumbs/thumb_SharkGuy2.png") S1 = Shapes.AddImage(P1) S2 = Shapes.AddImage(P2) Shapes.HideShape(S2) GraphicsWindow.Width = Desktop.Width-17 GraphicsWindow.Height = Desktop.Height-75 GraphicsWindow.Title = "Shark" GraphicsWindow.Left = .5 GraphicsWindow.Top = .5 LastFace = "D" Timer.Interval = 355 int = 0 Timer.Tick = Control Sub Control int = int + 15 If(Math.Remainder(Int, 10) = 0)Then Shapes.HideShape(S2) Shapes.ShowShape(S1) Show = "S1" Else Shapes.HideShape(S1) Shapes.ShowShape(S2) Show = "S2" EndIf K = GraphicsWindow.LastKey If(K = "Right")Then Facing = "D" Shapes.Move(S1, Shapes.GetLeft(S1)+50 Shapes.GetTop(S1)) Shapes.Move(S2, Shapes.GetLeft(S2)+50Shapes.GetTop(S2)) ElseIf(K = "Down")Then Facing = "S" Shapes.Move(S1, Shapes.GetLeft(S1) Shapes.GetTop(S1)+50) Shapes.Move(S2, Shapes.GetLeft(S2) Shapes.GetTop(S2)+50) ElseIf(K = "Left")Then Facing = "A" Shapes.Move(S1, Shapes.GetLeft(S1)-50 Shapes.GetTop(S1)) Shapes.Move(S2, Shapes.GetLeft(S2)-50 Shapes.GetTop(S2)) ElseIf(K = "Up")Then Facing = "W" Shapes.Move(S1, Shapes.GetLeft(S1) Shapes.GetTop(S1)-50) Shapes.Move(S2, Shapes.GetLeft(S2) Shapes.GetTop(S2)-50) EndIf If(Facing = "D")Then If(LastFace = "D")Then ElseIf(LastFace = "S")THen Shapes.Rotate(S1, -90) Shapes.Rotate(S2, -90) ElseIf(LastFace = "A")Then Shapes.Rotate(S1, 180) Shapes.Rotate(S2, 180) ElseIf(LastFace = "W")Then Shapes.Rotate(S1, 90) Shapes.Rotate(S2, 90) EndIf ElseIf(Facing = "S")Then If(LastFace = "D")Then Shapes.Rotate(S1, 90) Shapes.Rotate(S2, 90) ElseIf(LastFace = "S")THen ElseIf(LastFace = "A")Then Shapes.Rotate(S1, -90) Shapes.Rotate(S2, -90) ElseIf(LastFace = "W")Then Shapes.Rotate(S1, 180) Shapes.Rotate(S2, 180) EndIf ElseIf(Facing = "A")Then If(LastFace = "D")Then Shapes.Rotate(S1, 180) Shapes.Rotate(S2, 180) ElseIf(LastFace = "A")THen ElseIf(LastFace = "S")Then Shapes.Rotate(S1, 90) Shapes.Rotate(S2, 90) ElseIf(LastFace = "W")Then Shapes.Rotate(S1, -90) Shapes.Rotate(S2, -90) EndIf ElseIf(Facing = "W")Then If(LastFace = "D")Then Shapes.Rotate(S1, -90) Shapes.Rotate(S2, -90) ElseIf(LastFace = "W")THen ElseIf(LastFace = "A")Then Shapes.Rotate(S1, 90) Shapes.Rotate(S2, 90) ElseIf(LastFace = "S")Then Shapes.Rotate(S1, 180) Shapes.Rotate(S2, 180) EndIf EndIf LastFace = Facing endSub End>QVC538.sb< Start>QVC728.sb< lvl = 5 hp = 10 monname = "rat" monlvl = 5 monhp = 10 maxmonhp = 10 mondef = 2 wepattack = 10 '5 = wooden sword, 10 = iron sword, 20 = dark sword, and 40 = UBER sword armordef = 20 '5 = clothes, 20 = iron armor , 30 = knights armor 'dmg = lvl - mondef 'mondmg = monlvl - armordef TextWindow.WriteLine("You Have Encountered A Level 5 Rat") Battle: While monhp > 0 And hp > 0 If lvl > mondef Then dmg = Math.GetRandomNumber(lvl - mondef) Else dmg = 0 EndIf TextWindow.WriteLine("You Attack " + monname + " for " + dmg + " damage.") monhp = monhp - dmg TextWindow.WriteLine("Rat Has " + monhp + " left.") If monhp > 0 Then If monlvl > armordef Then mondmg = Math.GetRandomNumber(monlvl-armordef) Else mondmg = 0 EndIf TextWindow.WriteLine("You Get Attacked For " + mondmg + " Damage") hp = hp - mondmg TextWindow.WriteLine("You Have " + hp + " HP Left.") EndIf EndWhile If monhp = 0 Then TextWindow.WriteLine("You Have Deafeated Rat") EndIf If monhp < 0 Then TextWindow.WriteLine("You Have Defeated " + monname + " With an Overkill!!") EndIf If hp <= 0 Then TextWindow.WriteLine("I'm Sorry...You're dead!") EndIf End>QVC728.sb< Start>QVC731.sb< args=0 rdr="true bd="h:\ ddd=bd typ=LDText.Split("KB MB GB TB" " ") typ[0]="By" Sub lstt ' The following line could be harmful and has been automatically commented. ' st=File.GetDirectories(ddd) ' The following line could be harmful and has been automatically commented. ' fl=File.GetFiles(ddd) dd=Array.GetItemCount(st) d1=Array.GetItemCount(fl) For r=1 To dd st[r]="!>"+text.ConvertToUpperCase(Text.GetSubTextToEnd(st[r] 4)) EndFor For r=1 To d1 ' The following line could be harmful and has been automatically commented. ' st[ dd+r]= text.GetSubText( LDFile.GetExtension( fl[r])+" " 1 3)+text.GetSubText( LDfile.GetFile( fl[r])+" " 1 25)+"|"+text.GetSubText( LDFile.GetExtension( fl[r])+" " 1 3)+"|"+ldcall.Function("fsz" LDFile.Size(fl[r])) EndFor qq=LDArray.CreateFromValues(st) LDArray.Sort(qq) st=LDArray.CopyToSBArray(qq) For r=d1+1 To d1+30 ' st[ dd+r]=Text.GetSubText(" " 1 40) EndFor For f=1 To Array.GetItemCount(st) If Text.StartsWith(st[f] "!>") Then Else st[f]=Text.GetSubTextToEnd(st[f] 4) EndIf EndFor EndSub lstt() mk=30 lsl=1 cll=5 ii=1 jj=mk ldTextWindow.KeyDown=kkk GraphicsWindow.Title="files" GraphicsWindow.BackgroundColor="black GraphicsWindow.Width=66 LDEvents.MouseWheel=mww GraphicsWindow.Left=5 GraphicsWindow.Top=5 TextWindow.Title="NC Lister TextWindow.Left=135 TextWindow.Top=5 bo=Controls.AddButton(" OPEN " 5 5) Controls.ButtonClicked=bcc sfl=LDShell.SpecialFolders 'GraphicsWindow.ShowMessage(sfl "") sst=LDText.Replace(sfl["system"] "\\" "\") 'GraphicsWindow.ShowMessage(sst "") Sub bcc tt=text.GetSubTextToEnd( TextWindow.Title 3)+"\" 'LDDialogs.Wait(st[lsl+ii] "") sp=LDText.Split(st[lsl+ii] " ") tp=LDText.Split(st[lsl+ii] "|") tpp=Text.ConvertToLowerCase(tp[2]) If tpp="pdf" Then LDProcess.Start("J:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" tt+sp[1]+".pdf") ElseIf tpp="jpg" Then LDProcess.Start(sst+"\mspaint.exe" tt+sp[1]+".jpg") ElseIf tpp="txt" Then LDProcess.Start(sst+"\notepad.exe" tt+sp[1]+".txt") ElseIf tpp="bat" Then LDProcess.Start(sst+"\notepad.exe" tt+sp[1]+".bat") ElseIf tpp="bas" Then LDProcess.Start(sst+"\notepad.exe" tt+sp[1]+".bas") ElseIf tpp="ods" Then LDProcess.Start("J:\Program Files\LibreOffice\program\scalc.exe" tt+sp[1]+".ods") EndIf EndSub Sub fsz a=args[1] b=math.power(1024 math.floor(Math.log(a)/3)) tt=Math.Floor(Math.log(a)/3) If tt=0 Then return=typ[0]+" "+text.GetSubTextToEnd(1000+a 2) Else ml=text.GetSubTextToEnd(1000+LDMath.FixDecimal(a/b 2) 2) n=0 While Text.GetSubText(ml n+1 1)="0" n=n+1 EndWhile ml=Text.GetSubText(" " 1 n)+Text.GetSubTextToEnd(ml n+1) return=typ[tt]+" "+ml EndIf EndSub Sub mww If LDEvents.LastMouseWheelDelta<>0 Then If lsl+ii0 and lsl+ii>0 Then lsl=lsl-LDEvents.LastMouseWheelDelta EndIf If lsl>mk-1 Then If lsl+ii") Then ddd=bd+Text.GetSubTextToEnd(st[lsl+ii] 3) TextWindow.Title=">>"+ddd lstt() EndIf ElseIf lk="Down" Then lsl=lsl+1 If lsl>mk-1 Then lsl=mk-1 ii=ii+1 jj=jj+1 EndIf EndIf rdr="true 'TextWindow.Title=lk EndSub Sub drww TextWindow.CursorLeft=cll TextWindow.CursorTop=3 mm=40 TextWindow.ForegroundColor="cyan" ln=Text.GetSubText("╔════════════════════════════════════════════════" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.WriteLine(ln+"╗") For f=ii To jj TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.Write("║ ") If f-ii=lsl Then TextWindow.BackgroundColor="yellow" textWindow.ForegroundColor="black" Else TextWindow.ForegroundColor="cyan" EndIf TextWindow.Write(Text.GetSubText(ldtext.Replace( st[f] "_" " ")+" " 1 mm)) TextWindow.BackgroundColor="blue" TextWindow.ForegroundColor="cyan" TextWindow.Write(" ║") TextWindow.BackgroundColor="black" TextWindow.WriteLine("��") EndFor TextWindow.BackgroundColor="blue" ln=Text.GetSubText("╟────────────────────────────────────────────────" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.Write(ln+"╢") TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") TextWindow.BackgroundColor="blue" TextWindow.CursorLeft=cll ln=Text.GetSubText((lsl+ii)+"/"+Array.GetItemCount(st)+" " 1 mm)+" ║" TextWindow.Write("║ "+ln) TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") ln=Text.GetSubText("╚════════════════════════════════════════════════" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.Write(ln+"╝") TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") ln=Text.GetSubText("▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.WriteLine(" "+ln) EndSub End>QVC731.sb< Start>QVD944.sb< GraphicsWindow.BackgroundColor = "darkblue dw=math.Round(desktop.Width) dh=math.Round(desktop.Height) GraphicsWindow.Width = dw GraphicsWindow.Height = dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 GraphicsWindow.Title ="Earth-Moon rotation view3D = LD3DView.AddView(dw,dh,"True") 'Some different light types spot = LD3DView.AddSpotLight(view3D,"white",0,0,20,-0.5,-0.8,-1,5,100) spot = LD3DView.AddSpotLight(view3D,"yellow",0,0,20,-0.5,-0.85,-1,5,100) spot = LD3DView.AddSpotLight(view3D,"white",0,0,20,-0.7,-0.9,-1,5,100) LD3DView.AddDirectionalLight(view3D,"yellow",-1,-1,-1) LD3DView.AddDirectionalLight(view3D,"DarkBlue",1,1,1) LD3DView.AddAmbientLight(view3D,"#aaffffff") 'Initial camera position and direction and view angle aa=LDText.Split ("-28 -30 30 1 1 -1" " ") LD3DView.ResetCamera(view3D,aa[1],aa[2],aa[3],1, 1, -1,"","","") GraphicsWindow.BrushColor="red" LD3DView.AutoControl ("true" "true" ,-1 .3) ss[1]=1 ss[2]=.3 ff[1]="e:\earmm.png ff[2]="e:\moon.jpg For n=1 To 2 ball[n] = LD3DView.AddSphere(view3D,1,20,"red","D") LD3DView.AddImage(view3D,ball[n],"",ff[n],"D") If n>1 then LD3DView.ScaleGeometry (view3D,ball[n] ss[n] ss[n] ss[n]) LD3DView.TranslateGeometry(view3D,ball[n+1],0,0 n*2.5) Else LD3DView.AnimateRotation(view3D,ball[n] 0 0 1 0,360,1.2,-1) endif EndFor sq=180 i=sq 'LDEvents.MouseWheel=mww rr=3 Sub mww If GraphicsWindow.LastKey="A" Then rr=1 elseif GraphicsWindow.LastKey="S" Then rr=2 elseif GraphicsWindow.LastKey="D" Then rr=3 elseif GraphicsWindow.LastKey="Q" Then rr=4 elseif GraphicsWindow.LastKey="W" Then rr=5 elseif GraphicsWindow.LastKey="E" Then rr=6 endif aa[rr]=aa[rr]+LDEvents.LastMouseWheelDelta/50 LD3DView.ResetCamera(view3D,aa[1],aa[2],aa[3],aa[4] aa[5] aa[6],"","","") GraphicsWindow.Title ="" For e=1 To 6 GraphicsWindow.Title =GraphicsWindow.Title +aa[e]+" : " EndFor EndSub While "true i=i+.2 sy=ldmath.Sin (i-sq)*10 sx=ldmath.cos (i-sq)*10 LD3DView.RotateGeometry2 (view3D,ball[2] 0 0 1 i) LD3DView.TranslateGeometry (view3D,ball[2] sx sy 0) Program.Delay (20) endwhile End>QVD944.sb< Start>QVF018.sb< eng="1=1\=1\\\=0\\\;2\\\=0\\\;\;2\=1\\\=0\\\;2\\\=34\\\;\;3\=1\\\=133\\\;2\\\=100\\\;\;4\=1\\\=0\\\;2\\\=100\\\;\;5\=1\\\=0\\\;2\\\=200\\\;\;6\=1\\\=133\\\;2\\\=200\\\;\;7\=1\\\=0\\\;2\\\=266\\\;\;8\=1\\\=0\\\;2\\\=300\\\;\;9\=1\\\=67\\\;2\\\=300\\\;\;10\=1\\\=250\\\;2\\\=209\\\;\;11\=1\\\=250\\\;2\\\=300\\\;\;12\=1\\\=350\\\;2\\\=300\\\;\;13\=1\\\=350\\\;2\\\=209\\\;\;14\=1\\\=533\\\;2\\\=300\\\;\;15\=1\\\=600\\\;2\\\=300\\\;\;16\=1\\\=600\\\;2\\\=266\\\;\;17\=1\\\=467\\\;2\\\=200\\\;\;18\=1\\\=600\\\;2\\\=200\\\;\;19\=1\\\=600\\\;2\\\=100\\\;\;20\=1\\\=467\\\;2\\\=100\\\;\;21\=1\\\=600\\\;2\\\=34\\\;\;22\=1\\\=600\\\;2\\\=0\\\;\;23\=1\\\=533\\\;2\\\=0\\\;\;24\=1\\\=350\\\;2\\\=91\\\;\;25\=1\\\=350\\\;2\\\=0\\\;\;26\=1\\\=250\\\;2\\\=0\\\;\;27\=1\\\=250\\\;2\\\=91\\\;\;28\=1\\\=67\\\;2\\\=0\\\;\;;2=1\=1\\\=270\\\;2\\\=0\\\;\;2\=1\\\=270\\\;2\\\=120\\\;\;3\=1\\\=0\\\;2\\\=120\\\;\;4\=1\\\=0\\\;2\\\=180\\\;\;5\=1\\\=270\\\;2\\\=180\\\;\;6\=1\\\=270\\\;2\\\=300\\\;\;7\=1\\\=330\\\;2\\\=300\\\;\;8\=1\\\=330\\\;2\\\=180\\\;\;9\=1\\\=600\\\;2\\\=180\\\;\;10\=1\\\=600\\\;2\\\=120\\\;\;11\=1\\\=330\\\;2\\\=120\\\;\;12\=1\\\=330\\\;2\\\=0\\\;\;;3=1\=1\\\=0\\\;2\\\=0\\\;\;2\=1\\\=0\\\;2\\\=22\\\;\;3\=1\\\=155\\\;2\\\=100\\\;\;4\=1\\\=245\\\;2\\\=100\\\;\;5\=1\\\=45\\\;2\\\=0\\\;\;;4=1\=1\\\=555\\\;2\\\=0\\\;\;2\=1\\\=355\\\;2\\\=100\\\;\;3\=1\\\=445\\\;2\\\=100\\\;\;4\=1\\\=600\\\;2\\\=22\\\;\;5\=1\\\=600\\\;2\\\=0\\\;\;;5=1\=1\\\=155\\\;2\\\=200\\\;\;2\=1\\\=0\\\;2\\\=278\\\;\;3\=1\\\=0\\\;2\\\=300\\\;\;4\=1\\\=45\\\;2\\\=300\\\;\;5\=1\\\=245\\\;2\\\=200\\\;\;;6=1\=1\\\=355\\\;2\\\=200\\\;\;2\=1\\\=555\\\;2\\\=300\\\;\;3\=1\\\=600\\\;2\\\=300\\\;\;4\=1\\\=600\\\;2\\\=278\\\;\;5\=1\\\=445\\\;2\\\=200\\\;\;; bbb=LDShapes.BrushGradient("1=blue;2=darkblue" "DD") GraphicsWindow.PenWidth=0 GraphicsWindow.Title="Cook Isl. Flag GraphicsWindow.Width=1200 GraphicsWindow.Height=600 LDGraphicsWindow.BackgroundBrush(bbb) For f=1 To 6 GraphicsWindow.BrushColor="white If f>=2 Then GraphicsWindow.BrushColor="red EndIf pp=LDShapes.AddPolygon(eng[f]) If f=1 Then LDEffect.DropShadow(pp "") EndIf EndFor imm=LDText.Split("sand hend mns malv ascc brm fij" " ") n[1]="Saint Helena, Ascension and Tristan da Cunha dn[1]="are British Overseas Territories located in the South Atlantic ~and consisting of the island of Saint Helena, Ascension Island ~and the archipelago of Tristan da Cunha including Gough Island. ~Its name was Saint Helena and Dependencies until 1 September 2009 n[2]="The Falkland Islands (Isl.Malvines) dn[2]="is an archipelago in the South Atlantic Ocean on the Patagonian Shelf. n[3]="Pitcairn, Henderson, Ducie and Oeno Islands dn[3]="are a group of four volcanic islands in the southern Pacific Ocean ~that form the sole British Overseas Territory in the Pacific Ocean n[4]="Montserrat dn[4]="is a British Overseas Territory (BOT) in the Caribbean. ~The island is in the Leeward Islands, which is part of the chain known as ~the Lesser Antilles, in the West Indies. n[5]="South Georgia and the South Sandwich Islands (SGSSI) dn[5]="is a British Overseas Territory in the southern Atlantic Ocean. ~It is a remote and inhospitable collection of islands, consisting of South Georgia and a chain of smaller islands ~known as the South Sandwich Islands. n[6]="The Islands of Bermuda dn[6]="Bermuda is a British Overseas Territory in the North Atlantic Ocean. nmm=LDText.Split("#n5;#n3;#n4;#n2;#n1;#n6;Fiji" ";") ord=LDText.Split("5 3 4 2 1 6" " ") nl=Text.GetCharacter(13) for r=1 to 6 nmm=LDText.Replace(nmm "#n"+r n[r]) dn[r]=LDText.Replace(dn[r] "~" nl) EndFor rrr: for x=1 to 7 img=ImageList.LoadImage("e:\f"+imm[x]+".png") im=Shapes.AddImage(img) GraphicsWindow.Title=nmm[x] if x<7 then LDDialogs.ToolTip(im nmm[x]+nl+dn[ord[x]*1]) EndIf LDShapes.Centre(im 900 300) Program.Delay(5333) Shapes.Remove(im) EndFor goto rrr End>QVF018.sb< Start>QVH455-0.sb< ' Challenge of the Month - November 2016 // Guitar chords (By YLed) ' Finger action type by NaochanON QVH455-0 ' notes code is originally shown by YLed FQH300 Controls.ButtonClicked=Clicked init() data() TF="False" While "True" If TF="True" Then noteA=A[chord] noteN=N[chord] Sound.PlayMusic (noteA+noteN) Sound.PlayMusic (noteA+noteN) TF="False" EndIf Program.Delay(200) endwhile Sub Clicked chord =Controls.GetButtonCaption( Controls.LastClickedButton) GuitarPlay() TF="True" EndSub Sub GuitarPlay Shapes.SetText(note,chord) dS=-15 drad= Math.GetRadians(-ds) For i=1 To 4 cp=text.GetIndexOf(Cpos[chord][i],",") CX=text.GetSubText(Cpos[chord][i],1,cp-1)*100 CY=(text.GetSubTextToEnd(Cpos[chord][i],cp+1)-1)*20+205 Shapes.Move(Cshp[i],CX,CY ) Shapes.Rotate(Cshp[i],dS) Fx=Shapes.GetLeft(Cshp[i])+Claw[i]["height"]*s*Math.Sin(drad)/2-Finger[i]["height"]*s*Math.Sin(drad)/2 FY=Shapes.Gettop(Cshp[i])+Claw[i]["height"]*s*Math.cos(drad)/2-Finger[i]["height"]*s*Math.cos(drad) Shapes.Move(Fshp[i],FX-3,FY) Shapes.Rotate(Fshp[i],dS) Shapes.Move(ON[i],30,220+(El[chord][i]-1)*20-10) Shapes.Move(OFF[i],30,220+(XX[chord][i]-1)*20-10) EndFor EndSub Sub init GraphicsWindow.BrushColor="#F2F2B0" GraphicsWindow.FillRectangle(50,210,360,120) GraphicsWindow.BrushColor="#B48A76" GraphicsWindow.FillRectangle(10,180,50,180) For i= 1 To 6 GraphicsWindow.DrawLine(50,220+(i-1)*20,350,220+(i-1)*20) EndFor For i= 1 To 4 GraphicsWindow.DrawLine(50+(i-1)*100,220,50+(i-1)*100,320) EndFor GraphicsWindow.BrushColor="Green" GraphicsWindow.DrawText(20,20,"Guitar play // Finger action") GraphicsWindow.FontSize=60 note= Shapes.AddText("*") Shapes.Move(note,500,20) Finger[1] = "func=ell;x=100;y=100;width=26;height=120;bc=#FDE8D0;pc=#F1BF99;pw=2;" 'Index Finger[2] = "func=ell;x=120;y=100;width=26;height=120;bc=#FDE8D0;pc=#F1BF99;pw=2;" 'Middle Finger[3] = "func=ell;x=140;y=100;width=26;height=120;bc=#FDE8D0;pc=#F1BF99;pw=2;" 'Ring Finger[4] = "func=ell;x=160;y=100;width=26;height=120;bc=#FDE8D0;pc=#F1BF99;pw=2;" 'Little Finger[5] = "func=ell;x=80;y=330;width=130;height=30;bc=#FDE8D0;pc=#F1BF99;pw=2;" 'Thumb Claw[1] = "func=ell;x=103;y=190;width=20;height=30;bc=#3EB370;pc=#F1BF99;pw=2;" Claw[2] = "func=ell;x=123;y=190;width=20;height=30;bc=#C97586;pc=#F1BF99;pw=2;" Claw[3] = "func=ell;x=143;y=190;width=20;height=30;bc=#0094C8;pc=#F1BF99;pw=2;" Claw[4] = "func=ell;x=163;y=190;width=20;height=30;bc=#FFEA00;pc=#F1BF99;pw=2;" Claw[5] = "func=ell;x=80;y=340;width=30;height=15;bc=#E9DFE5;pc=#F1BF99;pw=2;" s=1 For i = 1 To 5 GraphicsWindow.penColor = Finger[i]["pc"] GraphicsWindow.PenWidth = Finger[i]["pw"] GraphicsWindow.BrushColor = Finger[i]["bc"] Fshp[i] = Shapes.AddEllipse(Finger[i]["width"]*s, Finger[i]["height"]*s) Shapes.Animate(Fshp[i], Finger[i]["x"]*s, Finger[i]["y"]*s, 500) Shapes.Rotate(FShp[i], Finger[i]["angle"]) EndFor For i = 1 To 5 GraphicsWindow.penColor = Claw[i]["pc"] GraphicsWindow.PenWidth = Claw[i]["pw"] GraphicsWindow.BrushColor = Claw[i]["bc"] Cshp[i] = Shapes.AddEllipse(Claw[i]["width"]*s, claw[i]["height"]*s) Shapes.Animate(Cshp[i], Claw[i]["x"]*s, Claw[i]["y"]*s, 500) Shapes.Rotate(CShp[i], Claw[i]["angle"]) EndFor GraphicsWindow.fontsize=16 For i=1 To 4 GraphicsWindow.BrushColor="Red" ON[i]=Shapes.AddText("〇") Shapes.Move(ON[i],20,-150) GraphicsWindow.BrushColor="Black OFF[i]=Shapes.AddText("X") Shapes.Move(OFF[i],30,-150) EndFor EndSub Sub data GraphicsWindow.BrushColor="Green" GraphicsWindow.FontSize=20 name="1=C;2=D;3=E;4=E7;5=Em;" For i=1 To Array.GetItemCount(name) Controls.AddButton(name[i],500,100+40*i) EndFor '----------------------------------------------------------------------------------------------- Cpos["C"]="1=1,2;2=2,4;3=3,5;4=-20,-20;" El["C"]="1=1;2=3;3=-20;4=-20;" XX["C"]="1=6;2=-20;3=-20;4=-20;" A["C"]="o4l32 C"+"o4l32 E"+"o4l32 G"+ "o5l32 C" ' un accord DO N["C"]="o5l1 E" '----------------------------------------------------------------------------------------------- Cpos["D"]="1=1.8,3;2=2.2,1;3=3,2;4=-20,-20;" El["D"]="1=4;2=-20;3=-20;4=-20;" XX["D"]="1=6;2=-20;3=-20;4=-20;" A["D"]="o4l32 D"+"o5l32 A"+"o5l32 D" ' un accord RE N["D"]="o5l1 F#" '----------------------------------------------------------------------------------------------- Cpos["E"]="1=1,3;2=1.8,5;3=2.2,4;4=-20,-20;" El["E"]="1=1;2=2;3=6;4=-20;" XX["E"]="1=-20;2=-20;3=-20;4=-20;" A["E"]="o3l32 E"+"o4l32 B"+"o4l32 E"+ "o4l32 G#"+"o5l32 B" ' un accord MI N["E"]="o5l1 E" '----------------------------------------------------------------------------------------------- Cpos["E7"]="1=1,3;2=2,5;3=-20,-20;4=-20,-20;" El["E7"]="1=1;2=2;3=4;4=6;" XX["E7"]="1=-20;2=-20;3=-20;4=-20;" A["E7"]="o3l32 E"+"o4l32 B"+"o4l32 E"+ "o4l32 G#" +"o5l32 D" ' un accord MI7 N["E7"]="o5l1 E" '----------------------------------------------------------------------------------------------- Cpos["Em"]="1=-20,-20;2=1.8,5;3=2.2,4;4=-20,-20;" El["Em"]="1=1;2=2;3=3;4=6;" XX["Em"]="1=-20;2=-20;3=-20;4=-20;" A["Em"]="o3l32 E"+"o4l32 B"+"o4l32 B"+ "o4l32 G"+"o5l32 B" ' un accord MI N["Em"]="o5l1 E" EndSub End>QVH455-0.sb< Start>QVK058.sb< ' No Keyboard input ! Only Mouse Input ! ' Please input a word to get a photo by "Flickr" and then set to wallpaper Data() GraphicsWindow.Clear() GraphicsWindow.Top=GWT1 GraphicsWindow.Left=GWL1 GraphicsWindow.Height=GWH1 GraphicsWindow.Width=GWW1 GraphicsWindow.BackgroundColor= "Lightcyan" GraphicsWindow.Title="Click and make a word to get a photo by Flickr" GraphicsWindow.Show() Key_Letter() Input_Area() Explane() GraphicsWindow.MouseDown=OnmouseDown Sub OnmouseDown MX=Graphicswindow.MouseX MY=Graphicswindow.MouseY Sound.PlayClick() If MX<5+DX2 or MX>5+DX2+WX*(Text.GetLength(D[1])) then Sound.PlayBellRing() 'Out of Area Goto END1 Endif If MYQVK058.sb< Start>QVL315.sb< GraphicsWindow.DrawText(10,10,"Reaction time") GraphicsWindow.DrawText(10,27,"Press a key after you hear a click") run=1 min=999999 max=0 avg=0 busy=0 GraphicsWindow.KeyDown=OnKeyDown While run<10 GraphicsWindow.DrawText(10,30+30*run,"round "+run) 'TextWindow.WriteLine("round "+run) d=1000+math.GetRandomNumber(3000) Program.Delay(d) Sound.PlayClick() start=Clock.ElapsedMilliseconds busy=1 While key=0 EndWhile key=0 endwhile GraphicsWindow.DrawText(10,400,"Twitter your result to @dohdoc") Sub OnKeyDown If busy=1 then end=Clock.ElapsedMilliseconds busy=0 t=end-start If t>0 then 'TextWindow.WriteLine(t) If tmax Then max=t EndIf avg=(avg*(run-1)+t)/run u=math.Round(avg*100)/100 GraphicsWindow.drawtext(120,30+30*run,t+"ms -> min="+min+", max="+max+", avg="+u) run=run+1 endif key=1 endif endsub End>QVL315.sb< Start>QVM180.sb< 'Number formatting prototpye - Created by Matthew L. Parets aka codingCat. No rights reserved. Use and distribute at your pleasure commaList[1] = 1 For i = 2 to 29 commaList[i] = (commaList[i-1] * 10) + math.Remainder(i,10) endfor For i = 1 to 29 commaNumber = commaList[i] AddCommasToNumber() TextWindow.WriteLine(commaNumber) endfor 'Add commas every three digits in a number Sub AddCommasToNumber commaNumber = "G" + commaNumber + "Q" 'random letters added to enforce concatenation rather than additon commaResult = "M" commaPos = 0 For actni = text.GetLength(commaNumber)-1 To 2 Step -1 'Stepping backwards through the number commaSub = Text.GetSubText(commaNumber,actni,1) 'The next digit commaPos = commaPos + 1 'The next position in the result If math.Remainder(commaPos-1,3) = 0 and text.GetLength(commaResult) > 3 Then 'time for a comma? commaResult = "," + commaResult 'Add a comma EndIf commaResult = commaSub + commaResult 'Add the next digit to the from EndFor commaNumber = text.GetSubText(commaResult,1,Text.GetLength(commaResult)-1) 'Return the number EndSub End>QVM180.sb< Start>QVM401.sb< ' SmallBasic Version 1.0 / 1.1 ' Program: NoSleep (Simulate activity to prevent system from hibernation) ' Changelog: 14.x, 15.4 ' Author: Pappa Lapub ' Website: https://social.msdn.microsoft.com/Forums/en-US/3b975ffc-cbfd-407c-ab95-74912e57c65d/challenge-of-the-month-april-2015 ' ImportURL: http://smallbasic.com/program/? ' Extension: Picollino Ext ' Comment: ' Variant A .. per TimerTick event ' Variant B .. per While "True" mainloop with delay ' ' Variables: define 'mins' (< minutes until hibernation) and 'tbh' (your Taskbar height) ' ToDo: ' ================================================================================ mins = 1 ' simulate activity every x minutes tbh = 60 ' Taskbar Height wait = mins * 60000 ' [ms] gw = 116 ' smallest GW.Width; NOT reachable between GW.Hide() and GW.Show() (-> 132) gh = 100 gw2 = gw/2 gh2 = gh/2 gl = Desktop.Width -gw-14 ' GW sits above tray (right bottom of screen) gt = Desktop.Height - tbh -gh-36 mx = gl + gw2 + 7 my = gt + gh2 + 29 GraphicsWindow.Left = gl GraphicsWindow.Top = gt GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "Lime" GraphicsWindow.BrushColor = "Red" GraphicsWindow.PenWidth = 0 rect = Shapes.AddRectangle(gw2,gh2) GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontSize = 62 '72 shpCounter = Shapes.AddText(counts) Shapes.Move(shpCounter, 0,12) rectX = "1=0;2=58;3=58;4=0;" ' 2 and 3 = gw2 rectY = "1=0;2=0;3=50;4=50;" ' 3 and 4 = gh2 Timer.Interval = wait '' A Timer.Tick = OnTimerTick '' A OnTimerTick() '' A ' ////////// Timer EVENT or MainLoop \\\\\\\\\\ Sub OnTimerTick '' A 'While "True" '' B n = Math.Remainder(n, 4) + 1 ' 1,2,3,4; 1,2,3,4; ... Shapes.Move(rect, rectX[n],rectY[n]) If (Mouse.MouseX > gl+7) And (Mouse.MouseX < gl+7+gw) And (Mouse.MouseY > gt+36) And (Mouse.MouseY < gt+29+gh) Then Else ' if cursor was found outside of GW, move it back into (and reset counter) Mouse.MouseX = mx Mouse.MouseY = my counts = 0 ' set back after, cursor been outside EndIf MouseControl.LeftClick() ' will NOT work without Shapes.SetText(shpCounter, counts) ' * mins) '' to show minutes and not # of cycles counts = counts + 1 'Program.Delay(wait) '' B 'EndWhile '' B EndSub '' A End>QVM401.sb< Start>QVT025.sb< 'Written by Thaelmann-Pioniere init() writename() drawCarbonnatom() For i = 1 To 3 Turtle.Angle=-45-90*(i-1) Turtle.PenDown() drawC_Hbond() drawHydrogenatom() Turtle.Turn(180) Turtle.PenUp() drawC_Obond() EndFor Turtle.Angle=45 For i = 1 To 16 Turtle.PenDown() drawC_Cbond() drawCarbonnatom() drawC_Hbond() drawHydrogenatom() Turtle.Turn(180) Turtle.PenUp() drawC_Hbond() If Math.Remainder(i,2)=1 Then Turtle.TurnRight() Else Turtle.TurnLeft() EndIf Turtle.PenDown() drawC_Hbond() drawHydrogenatom() Turtle.Turn(180) Turtle.PenUp() drawC_Hbond() EndFor Turtle.PenDown() drawC_Cbond() drawCarbonnatom() Turtle.Angle=0 drawC_Odoublebond() GraphicsWindow.BrushColor="Red" GraphicsWindow.FillEllipse(x-r,y-r,d,d) Turtle.PenDown() Turtle.Angle=120 drawC_Obond() drawOxygenatom() Turtle.PenUp() Turtle.Angle=60 drawH_Obond() drawHydrogenatom() Turtle.Turn(180) Turtle.PenDown() drawH_Obond() Turtle.Hide() Sub init r=10 d=r*2 GraphicsWindow.Title="Molecular Challenge-Stearic acid(CH3(CH2)16COOH)" GraphicsWindow.Height=500 GraphicsWindow.Width=1000 GraphicsWindow.BackgroundColor="#dabc72" GraphicsWindow.PenWidth=5 Turtle.Speed=10 Turtle.Angle=-45 Turtle.PenUp() Turtle.MoveTo(100,200) EndSub Sub writename GraphicsWindow.FontBold="false" GraphicsWindow.FontName="Times New Roman" GraphicsWindow.BrushColor="White" GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(500,20,"CH") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(570,50,"3") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(590,20,"(CH") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(680,50,"2") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(690,20,")") GraphicsWindow.FontSize=24 GraphicsWindow.DrawText(710,50,"16") GraphicsWindow.FontSize=48 GraphicsWindow.DrawText(740,20,"COOH") EndSub Sub drawHydrogenatom GraphicsWindow.BrushColor="White" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) EndSub Sub drawCarbonnatom GraphicsWindow.BrushColor="Black" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) EndSub Sub drawOxygenatom GraphicsWindow.BrushColor="Red" GraphicsWindow.FillEllipse(Turtle.X-r,Turtle.Y-r,d,d) EndSub Sub drawC_Obond GraphicsWindow.PenColor="Black" Turtle.Move(r+20) GraphicsWindow.PenColor="Red" Turtle.Move(r+20) EndSub Sub drawC_Hbond GraphicsWindow.PenColor="Black" Turtle.Move(r+20) GraphicsWindow.PenColor="White" Turtle.Move(r+20) EndSub Sub drawH_Obond GraphicsWindow.PenColor="White" Turtle.Move(r+20) GraphicsWindow.PenColor="Red" Turtle.Move(r+20) EndSub Sub drawC_Cbond GraphicsWindow.PenColor="Black" Turtle.Move(r+20+r) EndSub Sub drawC_Odoublebond Turtle.PenUp() Turtle.TurnLeft() Turtle.Move(4) Turtle.TurnRight() Turtle.PenDown() GraphicsWindow.PenColor="Black" Turtle.Move(r+20) GraphicsWindow.PenColor="Red" Turtle.Move(20+r) Turtle.TurnRight() Turtle.PenUp() Turtle.Move(4) x=Turtle.X y=Turtle.Y Turtle.Move(4) Turtle.TurnRight() Turtle.PenDown() GraphicsWindow.PenColor="Red" Turtle.Move(r+20) GraphicsWindow.PenColor="Black" Turtle.Move(20+r) Turtle.PenUp() Turtle.TurnRight() Turtle.Move(4) EndSub End>QVT025.sb< Start>QVW966.sb< GraphicsWindow.KeyDown = KeyDown GraphicsWindow.KeyUp=KeyUp GraphicsWindow.CanResize = "False" GraphicsWindow.Title="Menu" GraphicsWindow.Width="200" GraphicsWindow.Height="155" GraphicsWindow.BrushColor="#696969" Square=Shapes.AddRectangle(20,20) SinglePlayer=Shapes.AddText("SinglePlayer") Multiplayer=Shapes.AddText("MultiPlayer") Guide=Shapes.AddText("Guide") Exit=Shapes.AddText("Exit") Shapes.Zoom(SinglePlayer,2,2) Shapes.Zoom(Multiplayer,2,2) Shapes.Zoom(Guide,2,2) Shapes.Zoom(Exit,2,2) Shapes.Move(SinglePlayer,80,10) Shapes.Move(Multiplayer,76,50) Shapes.Move(Guide,59,90) Shapes.Move(Exit,53,130) Shapes.Move(Square,15,10) Rotate=0 Select=1 Gamemode=1 DeltaX=0.5 DeltaY=1.5 Speed=1 Score1=0 Score2=0 Up=0 Down=0 Up2=0 Down2=0 Gup=0 Timer.Interval = "10" Timer.Resume() Timer.Tick = EnemyMove 'Gamemodes, 1=Menu, 2=Guide, 3=SinglePlayer, 4=MultiPlayer While "True" ScoreBoard() RotateSet() Ballmove() Change() KeyCheck() CoordinateCheck() EndWhile Sub ScoreBoard Shapes.SetText(ScoreDisplay1,Score1) Shapes.SetText(ScoreDisplay2,Score2) If Gamemode=3 Or Gamemode=4 Then If Score1=3 Then p1win=Shapes.AddText("Player 1 Wins!") Shapes.Zoom(p1win,3,3) Shapes.Move(p1win,135,90) Sound.PlayChimeAndWait() Gamemode=1 CreateMenu() EndIf If Score2=3 Then p2win=Shapes.AddText("Player 2 Wins!") Shapes.Zoom(p2win,3,3) Shapes.Move(p2win,135,90) Sound.PlayChimeAndWait() Gamemode=1 CreateMenu() EndIf EndIf EndSub Sub KeyDown LastKey=GraphicsWindow.LastKey If Gamemode = 1 Then If LastKey="Up" Then If Select>1 Then Select=Select-1 EndIf EndIf If LastKey="Down" Then If Select<4 Then Select=Select+1 EndIf EndIf If LastKey = "Return" Then If Gamemode=1 Then If Select=1 Then CreateGame() Gamemode=3 ElseIf Select=2 Then CreateGame() Gamemode = 4 ElseIf Select=3 Then Gamemode=2 ShowHelp() ElseIf Select=4 Then Program.End() EndIf EndIf EndIf If Select=1 Then Shapes.Move(Square,15,10) ElseIf Select=2 Then Shapes.Move(Square,15,50) ElseIf Select=3 Then Shapes.Move(Square,15,90) ElseIf Select=4 Then Shapes.Move(Square,15,130) EndIf EndIf If Gamemode=3 Then If LastKey="Up" Then Up=1 ElseIf LastKey="Down" Then Down=1 EndIf EndIf If Gamemode=4 Then If LastKey="Up" Then Up=1 ElseIf LastKey="Down" Then Down=1 EndIf If LastKey="W" Then Up2=1 ElseIf LastKey="S" Then Down2=1 EndIf EndIf If Gup=1 Then If Gamemode=2 Then Gamemode=1 CreateMenu() Gup=0 EndIf EndIf If Gamemode=3 Or Gamemode=4 Then If LastKey = "Escape" Then CreateMenu() EndIf EndIf EndSub Sub KeyUp LastKey=GraphicsWindow.LastKey If Gamemode=3 Then If LastKey="Up" Then Up=0 ElseIf LastKey="Down" Then Down=0 EndIf EndIf If Gamemode=4 Then If LastKey="Up" Then Up=0 ElseIf LastKey="Down" Then Down=0 EndIf If LastKey="W" Then Up2=0 ElseIf LastKey="S" Then Down2=0 EndIf EndIf If Gamemode=2 Then If LastKey = "Return" Then Gup=1 EndIf EndIf EndSub Sub CoordinateCheck Paddle1x=Shapes.GetLeft(Paddle1) Paddle1y=Shapes.GetTop(Paddle1) Paddle2x=Shapes.GetLeft(Paddle2) Paddle2y=Shapes.GetTop(Paddle2) EndSub Sub KeyCheck If Gamemode=3 or Gamemode=4 Then If Paddle1y > 0 Then If Up=1 Then Shapes.Move(Paddle1, Paddle1x, Paddle1y-Speed) EndIf EndIf If Paddle1y < 150 Then If Down=1 Then Shapes.Move(Paddle1, Paddle1x, Paddle1y+Speed) EndIf EndIf If Paddle2y > 0 Then If Up2=1 Then Shapes.Move(Paddle2, Paddle2x, Paddle2y-Speed) EndIf EndIf If Paddle2y < 150 Then If Down2=1 Then Shapes.Move(Paddle2, Paddle2x, Paddle2y+Speed) EndIf EndIf EndIf EndSub Sub RotateSet If Gamemode=1 Then Program.Delay(10) Rotate=Rotate+1 Shapes.Rotate(Square,Rotate) EndIf EndSub Sub Change If Gamemode=3 or Gamemode=4 Then bx=Shapes.GetLeft(Ball)+5 by=Shapes.GetTop(Ball)+5 If gh-5by Then DeltaY = -DeltaY EndIf If 5>bx Then Score1=Score1+1 DeltaX = -DeltaX EndIf EndIf EndSub Sub Ballmove If Gamemode=3 or Gamemode=4 Then Glitchstop=Glitchstop+1 Program.Delay("6") x=x+DeltaX y=y+DeltaY Shapes.Move(Ball, x, y) EndIf EndSub Sub EnemyMove If Gamemode=3Then If Paddle2y+25 > by Then Shapes.Move(Paddle2, Paddle2x, Paddle2y-Speed) EndIf If Paddle2y+25 < by Then Shapes.Move(Paddle2, Paddle2x, Paddle2y+Speed) EndIf EndIf EndSub Sub CreateGame GraphicsWindow.Clear() GraphicsWindow.Title = "Pong" GraphicsWindow.Height="200" GraphicsWindow.Width="350" gw = GraphicsWindow.Width gh = GraphicsWindow.Height x= gw - gw/2 y= gh - gh/2 ScoreDisplay1=Shapes.AddText("0") ScoreDisplay2=Shapes.AddText("0") Shapes.Move(ScoreDisplay1,125,10) Shapes.Move(ScoreDisplay2,205,10) Paddle1=Shapes.AddRectangle(10,50) Paddle2=Shapes.AddRectangle(10,50) Shapes.Move(Paddle1, 300, 70) Shapes.Move(Paddle2, 30, 70) Shapes.Zoom(ScoreDisplay1,4,4) Shapes.Zoom(ScoreDisplay2,4,4) Paddle2x=Shapes.GetLeft(Paddle2) Paddle2y=Shapes.GetTop(Paddle2) Ball = Shapes.AddEllipse(10,10) Shapes.Move(Ball, x, y) EndSub Sub ShowHelp GraphicsWindow.Clear() GraphicsWindow.DrawText(0,0,"Controls:") GraphicsWindow.DrawText(0,15,"Player 1: Up and Down keys") GraphicsWindow.DrawText(0,30,"Player 2: W and S Keys") GraphicsWindow.DrawText(0,45,"Press Escape to exit the match") GraphicsWindow.DrawText(0,65,"Goal:") GraphicsWindow.DrawBoundText(0,80,190,"The Goal is to score against the opponent 5 times.") GraphicsWindow.DrawText(0,130,"Press Enter to continue...") EndSub Sub CreateMenu GraphicsWindow.Clear() Gamemode=1 GraphicsWindow.Title="Menu" GraphicsWindow.Width="200" GraphicsWindow.Height="155" Square=Shapes.AddRectangle(20,20) Shapes.Move(Square,15,10) SinglePlayer=Shapes.AddText("SinglePlayer") Multiplayer=Shapes.AddText("MultiPlayer") Guide=Shapes.AddText("Guide") Exit=Shapes.AddText("Exit") Shapes.Zoom(SinglePlayer,2,2) Shapes.Zoom(Multiplayer,2,2) Shapes.Zoom(Guide,2,2) Shapes.Zoom(Exit,2,2) Shapes.Move(SinglePlayer,80,10) Shapes.Move(Multiplayer,76,50) Shapes.Move(Guide,59,90) Shapes.Move(Exit,53,130) Rotate=0 Select=1 EndSub End>QVW966.sb< Start>QVZ298.sb< GraphicsWindow.KeyDown = HandleKey GraphicsWindow.BackgroundColor = "teal While "True"'--------------------------------------------------------------------main loop----- BOXES = 5 ' number of boxes per piece BWIDTH = 25 ' box width in pixels XOFFSET = 40 ' Screen X offset in pixels of where the board starts YOFFSET = 40 ' Screen Y offset in pixels of where the board starts CWIDTH = 10 ' Canvas Width, in number of boxes CHEIGHT = 20 ' Canvas Height, in number of boxes. STARTDELAY = 800 ENDDELAY = 175 PREVIEW_xpos = 13 PREVIEW_ypos = 2 GraphicsWindow.Clear() GraphicsWindow.Title = "Quintis GraphicsWindow.Height = 580 GraphicsWindow.Width = 700 GraphicsWindow.Show() SetupTemplates() SetupCanvas() template = Text.Append("template", Math.GetRandomNumber(4)) CreatePiece() ' in: template ret: h nextPiece = h end = 0 sessionDelay = STARTDELAY While end = 0 If sessionDelay > ENDDELAY Then sessionDelay = sessionDelay - 1 EndIf delay = sessionDelay thisPiece = nextPiece template = Text.Append("template", Math.GetRandomNumber(4)) CreatePiece() ' in: template ret: h nextPiece = h DrawPreviewPiece() h = thisPiece ypos = 0 done = 0 xpos = 3 ' always drop from column 3 CheckStop() ' in: ypos, xpos, h ret: done If done = 1 Then ypos = ypos - 1 MovePiece() 'in: ypos, xpos, h end = 1 EndIf yposdelta = 0 While done = 0 Or yposdelta > 0 MovePiece() 'in: ypos, xpos, h ' Delay, but break If the delay get set To 0 If the piece gets dropped delayIndex = delay While delayIndex > 0 And delay > 0 Program.Delay(10) delayIndex = delayIndex - 10 EndWhile If yposdelta > 0 Then yposdelta = yposdelta - 1 ' used To create freespin, when the piece is rotated Else ypos = ypos + 1 ' otherwise, move the piece down. EndIf ' Check If the piece should stop. CheckStop() ' in: ypos, xpos, h ret: done EndWhile EndWhile GraphicsWindow.ShowMessage( "Game Over", "Small Basic Tetris" ) EndWhile'---------------------------------------------------------------------------------------------------- Sub HandleKey ' Stop game If GraphicsWindow.LastKey = "Escape" Then Program.End() EndIf ' Move piece left If GraphicsWindow.LastKey = "Left" Then moveDirection = -1 ValidateMove() ' in: ypos, xpos, h, moveDirection ret: invalidMove = 1 or -1 or 2 If move is invalid, otherwise 0 If invalidMove = 0 Then xpos = xpos + moveDirection EndIf MovePiece() 'in: ypos, xpos, h EndIf ' Move piece right If GraphicsWindow.LastKey = "Right" Then moveDirection = 1 ValidateMove() ' in: ypos, xpos, h, moveDirection ret: invalidMove = 1 or -1 or 2 If move is invalid, otherwise 0 If invalidMove = 0 Then xpos = xpos + moveDirection EndIf MovePiece() 'in: ypos, xpos, h EndIf ' Move piece down If GraphicsWindow.LastKey = "Down" or GraphicsWindow.LastKey = "Space" Then delay = 20 EndIf ' Rotate piece If GraphicsWindow.LastKey = "Up" Then basetemplate = array.GetValue(h, -1) ' array.GetValue(h, -1) = the template name template = "temptemplate" rotation = "CW" CopyPiece() 'in basetemplate, template, rotation array.SetValue(h, -1, template) ' array.GetValue(h, -1) = the template name moveDirection = 0 ValidateMove() ' in: ypos, xpos, h, moveDirection ret: invalidMove = 1 or -1 or 2 If move is invalid, otherwise 0 ' See If it can be moved so that it will rotate. xposbk = xpos yposdelta = 0 While yposdelta = 0 And Math.Abs(xposbk - xpos) < 3 ' move up To 3 times only ' If the rotation move worked, copy the temp To "rotatedtemplate" and use that from now on If invalidMove = 0 Then basetemplate = template template = "rotatedtemplate" array.SetValue(h, -1, template) ' array.GetValue(h, -1) = the template name rotation = "COPY" CopyPiece() 'in basetemplate, template, rotation yposdelta = 1 ' Don't move down If we rotate MovePiece() 'in: ypos, xpos, h ElseIf invalidMove = 2 Then ' Don't support shifting piece when hitting another piece To the right or left. xpos = 99 ' exit the loop Else ' If the rotated piece can't be placed, move it left or right and try again. xpos = xpos - invalidMove ValidateMove() ' in: ypos, xpos, h, moveDirection ret: invalidMove = 1 or -1 or 2 If move is invalid, otherwise 0 EndIf EndWhile If invalidMove <> 0 Then xpos = xposbk array.SetValue(h, -1, basetemplate) ' array.GetValue(h, -1) = the template name template = "" EndIf EndIf EndSub Sub DrawPreviewPiece xpos = PREVIEW_xpos ypos = PREVIEW_ypos h = nextPiece XOFFSETBK = XOFFSET YOFFSETBK = YOFFSET XOFFSET = XOFFSET + array.GetValue(array.GetValue(h, -1), "pviewx") ' array.GetValue(h, -1) = the template name YOFFSET = YOFFSET + array.GetValue(array.GetValue(h, -1), "pviewy") ' array.GetValue(h, -1) = the template name MovePiece() 'in: ypos, xpos, h XOFFSET = XOFFSETBK YOFFSET = YOFFSETBK EndSub Sub CopyPiece 'in basetemplate, template, rotation L = array.GetValue(basetemplate, "dim") If rotation = "CW" Then For i = 0 To BOXES - 1 ' x' = y y' = L - 1 - x v = array.GetValue(basetemplate, i) x = (Math.Remainder(v, 10)) y = (L - 1 - Math.Floor(v/10)) array.SetValue(template, i, x * 10 + y) EndFor ElseIf rotation = "COPY" Then For i = 0 To BOXES - 1 array.SetValue(template, i, array.GetValue(basetemplate, i)) EndFor Else GraphicsWindow.ShowMessage("invalid parameter", "Error") Program.End() EndIf array.SetValue(template, "color", array.GetValue(basetemplate, "color")) array.SetValue(template, "dim", array.GetValue(basetemplate, "dim")) array.SetValue(template, "pviewx", array.GetValue(basetemplate, "pviewx")) array.SetValue(template, "pviewy", array.GetValue(basetemplate, "pviewy")) EndSub Sub CreatePiece ' in: template ret: h hcount = hcount + 1 h = Text.Append("piece", hcount) array.SetValue(h, -1, template) ' array.GetValue(h, -1) = the template name GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = array.GetValue(template, "color") For i = 0 To BOXES - 1 s = Shapes.AddRectangle(BWIDTH, BWIDTH) Shapes.Move(s, -BWIDTH, -BWIDTH) ' move off screen array.SetValue(h, i, s) EndFor EndSub Sub MovePiece 'in: ypos, xpos, h. ypos/xpos is 0-19, representing the top/left box coordinate of the piece on the canvas. h returned by CreatePiece For i = 0 To BOXES - 1 v = array.GetValue(array.GetValue(h, -1), i) ' array.GetValue(h, -1) = the template name x = Math.Floor(v/10) y = Math.Remainder(v, 10) Shapes.Move(array.GetValue(h, i), XOFFSET + xpos * BWIDTH + x * BWIDTH, YOFFSET + ypos * BWIDTH + y * BWIDTH) EndFor EndSub Sub ValidateMove ' in: ypos, xpos, h, moveDirection ret: invalidMove = 1 or -1 or 2 If move is invalid, otherwise 0 i = 0 invalidMove = 0 While i < BOXES v = array.GetValue(array.GetValue(h, -1), i) ' array.GetValue(h, -1) = the template name x = Math.Floor(v/10) y = Math.Remainder(v, 10) If (x + xpos + moveDirection) < 0 Then invalidMove = -1 i = BOXES ' force getting out of the loop EndIf If (x + xpos + moveDirection) >= CWIDTH Then invalidMove = 1 i = BOXES ' force getting out of the loop EndIf If array.GetValue("c", (x + xpos + moveDirection) + (y + ypos) * CWIDTH) <> "." Then invalidMove = 2 i = BOXES ' force getting out of the loop EndIf i = i + 1 EndWhile EndSub Sub CheckStop ' in: ypos, xpos, h ret: done done = 0 i = 0 While i < BOXES v = array.GetValue(array.GetValue(h, -1), i) ' array.GetValue(h, -1) = the template name x = Math.Floor(v/10) y = Math.Remainder(v, 10) If y + ypos > CHEIGHT Or array.GetValue("c", (x + xpos) + (y + ypos) * CWIDTH) <> "." Then done = 1 i = BOXES ' force getting out of the loop EndIf i = i + 1 EndWhile If done = 1 Then For i = 0 To BOXES - 1 v = array.GetValue(array.GetValue(h, -1), i) ' array.GetValue(h, -1) = the template name array.SetValue("c", (Math.Floor(v/10) + xpos) + (Math.Remainder(v, 10) + ypos - 1) * CWIDTH, array.GetValue(h, i)) EndFor score = score + 1 GraphicsWindow.Title="Score: "+score DeleteLines() EndIf EndSub Sub DeleteLines linesCleared = 0 ' Iterate over each row, starting from the bottom For y = CHEIGHT - 1 To 0 Step -1 x = CWIDTH While x = CWIDTH x = 0 While x < CWIDTH piece = array.GetValue("c", x + y * CWIDTH) If piece = "." Then x = CWIDTH EndIf x = x + 1 EndWhile If x = CWIDTH Then For x1 = 0 To CWIDTH - 1 Shapes.Remove(array.GetValue("c", x1 + y * CWIDTH)) EndFor linesCleared = linesCleared + 1 ' Move everything Else down one. For y1 = y To 1 Step -1 For x1 = 0 To CWIDTH - 1 piece = array.GetValue("c", x1 + (y1 - 1) * CWIDTH) array.SetValue("c", x1 + y1 * CWIDTH, piece) Shapes.Animate(piece, Shapes.GetLeft(piece), Shapes.GetTop(piece) + BWIDTH,250) EndFor EndFor Program.Delay(500) EndIf EndWhile EndFor If linesCleared > 0 Then score = score + 100 * Math.Round(linesCleared * 2.15 - 1) GraphicsWindow.Title="Score: "+score EndIf EndSub Sub SetupCanvas GraphicsWindow.BackgroundColor="teal GraphicsWindow.Clear() GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "PeachPuff For x = 0 To CWIDTH-1 For y = 0 To CHEIGHT-1 array.SetValue("c", x + y * CWIDTH, ".") ' "." indicates spot is free GraphicsWindow.DrawRectangle(XOFFSET + x * BWIDTH, YOFFSET + y * BWIDTH, BWIDTH, BWIDTH) EndFor EndFor GraphicsWindow.PenWidth = 4 GraphicsWindow.PenColor = "Black" GraphicsWindow.DrawLine(XOFFSET, YOFFSET, XOFFSET, YOFFSET + CHEIGHT*BWIDTH) GraphicsWindow.DrawLine(XOFFSET + CWIDTH*BWIDTH, YOFFSET, XOFFSET + CWIDTH*BWIDTH, YOFFSET + CHEIGHT*BWIDTH) GraphicsWindow.DrawLine(XOFFSET, YOFFSET + CHEIGHT*BWIDTH, XOFFSET + CWIDTH*BWIDTH, YOFFSET + CHEIGHT*BWIDTH) GraphicsWindow.PenColor = "Lime" GraphicsWindow.DrawLine(XOFFSET - 4, YOFFSET, XOFFSET - 4, YOFFSET + CHEIGHT*BWIDTH + 6) GraphicsWindow.DrawLine(XOFFSET + CWIDTH*BWIDTH + 4, YOFFSET, XOFFSET + CWIDTH*BWIDTH + 4, YOFFSET + CHEIGHT*BWIDTH + 6) GraphicsWindow.DrawLine(XOFFSET - 4, YOFFSET + CHEIGHT*BWIDTH + 4, XOFFSET + CWIDTH*BWIDTH + 4, YOFFSET + CHEIGHT*BWIDTH + 4) GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "cyan x = XOFFSET + PREVIEW_xpos * BWIDTH - BWIDTH y = YOFFSET + PREVIEW_ypos * BWIDTH - BWIDTH score = 0 GraphicsWindow.Title="Score: "+score EndSub Sub SetupTemplates array.SetValue("template1", 0, 00) array.SetValue("template1", 1, 01) array.SetValue("template1", 2, 11) array.SetValue("template1", 3, 21) array.SetValue("template1", 4, 20) array.SetValue("template1", "color", "Yellow") array.SetValue("template1", "dim", 3) array.SetValue("template1", "pviewx", -12) array.SetValue("template1", "pviewy", 12) array.SetValue("template3", 0, 10) array.SetValue("template3", 1, 01) array.SetValue("template3", 2, 11) array.SetValue("template3", 3, 21) array.SetValue("template3", 4, 12) array.SetValue("template3", "color", "Lime") array.SetValue("template3", "dim", 3) array.SetValue("template3", "pviewx", 0) array.SetValue("template3", "pviewy", 25) array.SetValue("template2", 0, 10) array.SetValue("template2", 1, 11) array.SetValue("template2", 2, 12) array.SetValue("template2", 3, 13) array.SetValue("template2", 4, 14) array.SetValue("template2", "color", "Red") array.SetValue("template2", "dim", 5) array.SetValue("template2", "pviewx", 0) array.SetValue("template2", "pviewy", 0) array.SetValue("template4", 0, 01) array.SetValue("template4", 1, 11) array.SetValue("template4", 2, 21) array.SetValue("template4", 3, 12) array.SetValue("template4", 4, 13) array.SetValue("template4", "color", "cyan") array.SetValue("template4", "dim", 4) array.SetValue("template4", "pviewx", 0) array.SetValue("template4", "pviewy", 25) EndSub End>QVZ298.sb< Start>QVZ834.sb< 'A3 cipher 'Programmer Amir Rke 'https:facebook.com/incredibleamir '_______________________________________________________ '#################Show Graphics window###################### '----------------------------------------------------------------------------------------------- onLoad() Sub init init_Vars() gww = 600 gwh = 400 GraphicsWindow.Width = gww GraphicsWindow.Height = gwh GraphicsWindow.CanResize = 0 GraphicsWindow.Title = "A3 Cipher By Amir Version 1.0" GraphicsWindow.Show() '----------------------------------------------------------------------------------------------- '_______________________________________________________ '################Add Controls############################## '----------------------------------------------------------------------------------------------- '**********************Main Text Box*************************************** GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontBold = "False" GraphicsWindow.FontSize = 15 textBoxMain = Controls.AddMultiLineTextBox(10,10) Controls.SetSize(textBoxMain,gww-20,gwh-70) GraphicsWindow.FontSize = 20 GraphicsWindow.FontBold = "True" textBoxKey = Controls.AddTextBox(10,gwh-50) Controls.SetSize(textBoxKey,300,30) GraphicsWindow.FontSize = 12 GraphicsWindow.BrushColor = "DarkBlue" '----------------------------------------------------------------------------------------------- '_______________________________________________________ '################Add Buttons############################### '----------------------------------------------------------------------------------------------- enCryptBtn = Controls.AddButton("Encrypt",320,gwh-50) deCryptBtn = Controls.AddButton("Decrypt",392,gwh-50) openFileBtn = Controls.AddButton("Open File",464,gwh-50) exitBtn = Controls.AddButton("Save",545,gwh-50) '_______________________________________________________ '##################Progress lables########################## '---------------------------------------------------------------------------------------------- GraphicsWindow.DrawText(10,gwh-15,"Process : ") process = Shapes.AddText(0) Shapes.Move(process,70,gwh-15) GraphicsWindow.DrawText(100,gwh-15,"Progress : ") progress = Shapes.AddText("0 %") Shapes.Move(progress,165,gwh-15) GraphicsWindow.DrawText(355,gwh-15,"Press 'F1' to generate random keyword") EndSub '----------------------------------------------------------------------------------------------- '_______________________________________________________ '##################Variable initialization###################### '----------------------------------------------------------------------------------------------- Sub init_Vars 'handle ascii values outside of range offset[1] = 0 mod[offset[1]] = 0 'handle ascii values between 65-90 offset[2] = 65 mod[offset[2]] = 26 'handle ascii values between 97-122 offset[3] = 97 mod[offset[3]] = 26 'handle ascii values between 48-57 offset[4] = 48 mod[offset[4]] = 10 'handle ascii values between 0-47 offset[5] = 0 mod[offset[5]] = 48 'hansle ascii values between 91-96 offset[6] = 91 mod[offset[6]] = 6 'handle ascii values between 58-64 offset[7] = 7 mod[offset[7]] = 7 'handle ascii values 123 - 127 offset[8] = 123 mod[offset[8]] = 5 i = 1 count = 1 keyword = "" EndSub '----------------------------------------------------------------------------------------------- '________________________________________________________ '##################Progress Show############################# Sub updatePro If argue = "" Then Shapes.SetText(progress,Math.Round((i*100)/stringLenght)+" %") EndIf EndSub Sub updateProcess If argue = "" Then Shapes.SetText(process,j) EndIf EndSub '------------------------------------------------------------------------------------------------- '_______________________________________________________ '##################Event Handler########################### '----------------------------------------------------------------------------------------------- Controls.ButtonClicked = onClick GraphicsWindow.KeyDown = keyDown '----------------------------------------------------------------------------------------------- '________________________________________________________ '######################Key Dots############################ ' under development '------------------------------------------------------------------------------------------------- '________________________________________________________ '###################Button Click Handler####################### '------------------------------------------------------------------------------------------------- Sub onCLick lastCliked = Controls.LastClickedButton If lastCliked = "Button1" Then getKeyString() If keyLenght <> 0 And stringLenght <> 0 Then repeatKey() ciPher() outPut() saveKey() Else sHowError() EndIf ElseIf lastCliked = "Button2" Then getKeyString() If keyLenght <> 0 And stringLenght <> 0 Then repeatKey() deCipher() outPut() saveKey() Else sHowError() EndIf ElseIF lastCliked = "Button3" Then openFile() ElseIF lastCliked = "Button4" Then getKeyString() If keyLenght <> 0 And stringLenght <> 0 Then saveFile() Else sHowError() EndIf EndIf EndSub '--------------------------------------------------------------------------------------------------- '__________________________________________________________ '#################File Open Event Handler######################## '---------------------------------------------------------------------------------------------------- Sub openFile filepath = LDDialogs.OpenFile("txt") ' The following line could be harmful and has been automatically commented. ' fileData = File.ReadContents(filepath) Controls.SetTextBoxText(textBoxMain,fileData) EndSub '----------------------------------------------------------------------------------------------------- '___________________________________________________________ '#####################File save ivent handler###################### '----------------------------------------------------------------------------------------------------- Sub saveFile fileData = Controls.GetTextBoxText(textBoxMain) filepath = LDDialogs.SaveFile("txt") ' The following line could be harmful and has been automatically commented. ' File.WriteContents(filepath,fileData) EndSub '------------------------------------------------------------------------------------------------------ '___________________________________________________________ '#######################Encryption############################ '----------------------------------------------------------------------------------------------------- Sub ciPher j = 2 updateProcess() For i = 1 To stringLenght updatePro() getKeyChar() getStringChar() If stringChar >= 0 And stringChar <= 47 Then enCryptChar() appendChar() Else appendChar() EndIf EndFor EndSub '------------------------------------------------------------------------------------------------------ '___________________________________________________________ '#################Decryption################################## '------------------------------------------------------------------------------------------------------ Sub deCipher j = 2 updateProcess() For i = 1 To stringLenght updatePro() getKeyChar() getStringChar() If stringChar >= 0 And stringChar <= 47 Then deCryptChar() cHeck() appendChar() Else appendChar() EndIf EndFor EndSub '------------------------------------------------------------------------------------------------------- '____________________________________________________________ '######################Get Character from key##################### '------------------------------------------------------------------------------------------------------- Sub getKeyChar keyChar = Text.GetCharacterCode(Text.GetSubText(keyword,i,1)) If keyChar >= 65 And keyChar <= 90 Then valk = 2 ElseIf keyChar >= 97 And keyChar <= 122 Then valk = 3 ElseIf keyChar >= 48 And keyChar <= 57 Then valk = 4 EndIf keyChar = keyChar - offset[valk] EndSub '--------------------------------------------------------------------------------------------------------- '_____________________________________________________________ '#####################Get Character from String###################### '--------------------------------------------------------------------------------------------------------- Sub getStringChar stringChar = Text.GetCharacterCode(Text.GetSubText(string,i,1)) If stringChar >= 65 And stringChar <= 90 Then vals = 2 ElseIf stringChar >= 97 And stringChar <= 122 Then vals = 3 ElseIf stringChar >= 48 And stringChar <= 57 Then vals = 4 ElseIf stringChar >= 0 And stringChar <= 47 Then vals = 5 ElseIf stringChar >= 91 And stringChar <= 96 Then vals = 6 ElseIf stringChar >= 58 And stringChar <= 64 Then vals = 7 ElseIf stringChar >= 123 And stringChar <= 127 Then vals = 8 EndIf stringChar = stringChar - offset[vals] EndSub '------------------------------------------------------------------------------------------------------------ '_______________________________________________________________ '#####################Encrytp Character############################# '------------------------------------------------------------------------------------------------------------ Sub enCryptChar enchar = Math.Remainder(keychar+stringChar,mod[offset[vals]]) + offset[vals] EndSub '------------------------------------------------------------------------------------------------------------ '_______________________________________________________________ '####################Decrypt Char################################## '------------------------------------------------------------------------------------------------------------- Sub deCryptChar enchar = Math.Remainder(stringChar - keyChar,mod[offset[vals]]) + offset[vals] EndSub '------------------------------------------------------------------------------------------------------------- '________________________________________________________________ '######################Append Characters############################ '-------------------------------------------------------------------------------------------------------------- Sub appendChar If stringChar >= 0 And stringChar <= 47 Then enstring = Text.Append(enstring,Text.GetCharacter(enchar)) Else enstring = Text.Append(enstring,Text.GetCharacter(stringChar + offset[vals])) EndIf EndSub '--------------------------------------------------------------------------------------------------------------- '_________________________________________________________________ '######################Repeat the key################################# '---------------------------------------------------------------------------------------------------------------- Sub repeatKey j = 1 updateProcess() init_Vars() While Text.GetLength(keyword) < stringLenght If count > keyLenght Then count = 1 EndIf keyLetter = Text.GetSubText(key,count,1) keyword = keyword + keyLetter count = count + 1 i = i + 1 updatePro() EndWhile keyLenght = Text.GetLength(keyword) EndSub '--------------------------------------------------------------------------------------------------------------- '_________________________________________________________________ '#################Decrypter offset Check################################ '--------------------------------------------------------------------------------------------------------------- Sub cHeck If enchar < offset[vals] Then enchar = enchar + mod[offset[vals]] EndIf EndSub '---------------------------------------------------------------------------------------------------------------- '_________________________________________________________________ '##############Get key and string from text boxes########################### '---------------------------------------------------------------------------------------------------------------- Sub getKeyString If argue <> "" Then key = arguekey string = argustring Else key = Controls.GetTextBoxText(textBoxKey) string = Controls.GetTextBoxText(textBoxMain) EndIf keyLenght = Text.GetLength(key) stringLenght = Text.GetLength(string) EndSub '------------------------------------------------------------------------------------------------------------------ '___________________________________________________________________ '###########Print The final output into the textbox############################## '------------------------------------------------------------------------------------------------------------------- Sub outPut Controls.SetTextBoxText(textBoxMain,enstring) enstring = "" EndSub '-------------------------------------------------------------------------------------------------------------------- '____________________________________________________________________ '################Show error if fiels are empty################################ '--------------------------------------------------------------------------------------------------------------------- Sub sHowError GraphicsWindow.ShowMessage("Either Text box or Key box is empty or may be both","Error") EndSub '--------------------------------------------------------------------------------------------------------------------- '____________________________________________________________________ '##########Drag-n-Drop encrypter console(Experimental) currently not working######### '--------------------------------------------------------------------------------------------------------------------- Sub onLoad argue = Program.GetArgument(1) If argue <> "" Then ' The following line could be harmful and has been automatically commented. ' argustring = File.ReadContents(argue) TextWindow.WriteLine("Enter key") arguekey = TextWindow.Read() TextWindow.Hide() init_Vars() getKeyString() repeatKey() ciPher() TextWindow.WriteLine("Give your encrypted file a name") name = TextWindow.Read() ' The following line could be harmful and has been automatically commented. ' File.WriteContents(Program.Directory+"\"+name+".txt",string) Program.End() Else init() EndIf EndSub '----------------------------------------------------------------------------------------------------------------------- '_____________________________________________________________________' '#####################Random key Generater################################ '----------------------------------------------------------------------------------------------------------------------- Sub keyDown If GraphicsWindow.LastKey = "F1" Then randKey() EndIf EndSub Sub randKey chars = "abcdefghijklmnopqrstuvwxyz1234567890" lenght = 25 keyw = "" While Text.GetLength(keyw) < lenght randigit = Math.GetRandomNumber(36) kchar = Text.GetSubText(chars,randigit,1) keyw = keyw + kchar EndWhile Controls.SetTextBoxText(textBoxKey,keyw) EndSub '------------------------------------------------------------------------------------------------------------------------- '______________________________________________________________________ '########################Prompt to save key################################ '------------------------------------------------------------------------------------------------------------------------ Sub saveKey return = PlusPlusDialogs.ShowMessage("Save key on local drive?","Save Key","YesNo","Question","Button2") If return = "Yes" Then path = LDDialogs.SaveFile("txt") ' The following line could be harmful and has been automatically commented. ' File.WriteContents(path,key) Controls.SetTextBoxText(textBoxKey,"") EndIf EndSub End>QVZ834.sb< Start>QWC600.sb< Sub Init gh = GraphicsWindow.Height gw = GraphicsWindow.Width For raws = 1 To 8 For columns = 0 To 8 GraphicsWindow.PenColor = "Blue" drop[columns][raws] = Shapes.AddLine(10,0,10,20) x[columns][raws] = columns * 70 y[columns][raws] = raws * 50 - gh Shapes.Move(drop[columns][raws],x[columns][raws],y[columns][raws]) Shapes.Rotate(drop[columns][raws],15) EndFor EndFor EndSub Init() While 1 = 1 For raws = 1 To 8 For columns = 0 To 8 random = Math.GetRandomNumber(10) y[columns][raws] = y[columns][raws] + random x[columns][raws] = x[columns][raws] - (random / 3) Shapes.Move(drop[columns][raws], x[columns][raws], y[columns][raws]) If y[columns][raws] > gh Then y[columns][raws] = y[columns][raws] - gh - 30 EndIf If x[columns][raws] < 0 Then x[columns][raws] = x[columns][raws] + gw EndIf EndFor EndFor EndWhile End>QWC600.sb< Start>QWD239.sb< GraphicsWindow.BackgroundColor="teal GraphicsWindow.BrushColor="orange GraphicsWindow.Title ="Brickout GraphicsWindow.Width =950 zz=1 LDEvents.MouseWheel=mww LDShapes.ShapeEvent=see GraphicsWindow.KeyDown =mdd ii= LDText.Split ("Glass Brick Hide ShowAll" " ") LDDialogs.AddRightClickMenu(ii "") LDDialogs.RightClickMenu=rmm Sub rmm mm=LDDialogs.LastRightClickMenuItem cmm=mm EndSub Sub mdd lk= GraphicsWindow.LastKey If lk="Left" Then px=px-20 ElseIf lk="Right" then px=px+20 ElseIf lk="Up" or Text.IsSubText (lk "hift") then py=py-20 ElseIf lk="Down" then py=py+20 endif LDGraphicsWindow.Reposition (zz zz px py 0) EndSub Sub see ls= LDShapes.LastEventShape If LDShapes.LastEventType="MouseDown" Then If cmm=3 then Shapes.HideShape (ls) ElseIf cmm=1 then LDShapes.BrushColour (ls "#aa0088cc") endif endif EndSub hp[1][1]=0 hp[1][2]=0 hp[2][1]=40 hp[2][2]=0 hp[3][1]=52 hp[3][2]=-10 hp[4][1]=12 hp[4][2]=-10 vp[1][1]=0 vp[1][2]=0 vp[2][1]=0 vp[2][2]=20 vp[3][1]=12 vp[3][2]=10 vp[4][1]=12 vp[4][2]=-10 dp[1][1]=0 dp[1][2]=0 dp[2][1]=0 dp[2][2]=20 dp[3][1]=20 dp[3][2]=0 dp[4][1]=20 dp[4][2]=-20 dt[1][1]=0 dt[1][2]=0 dt[2][1]=20 dt[2][2]=0 dt[3][1]=40 dt[3][2]=-20 dt[4][1]=20 dt[4][2]=-20 f2=1.5 For y=1 To 6'------------------rows For x=5 to 1 Step -1 GraphicsWindow.PenWidth =0 dr=math.Remainder ((y-1) 2)*20 p300=355 p20=28 if dr>0 And x=5 Then For x=1 to 5 rr=x*20-10 dww() EndFor x=5 endif rr=x*20'math.Remainder (y 2)*20 s[y][f]=Shapes.AddRectangle (40 20) h[y][f]=LDShapes.AddPolygon (hp) v[y][f]=LDShapes.AddPolygon (vp) LDShapes.BrushColour ( h[y][f] "brown") LDShapes.BrushColour ( v[y][f] LDColours.HSLtoRGB (0 .8 .2)) Shapes.Move (s[y][f] x*42+rr+p20+dr p300-y*22-rr) Shapes.Move (h[y][f] x*42+rr+p20+dr p300-y*22-rr) Shapes.Move (v[y][f] x*42+40+rr+p20+dr p300-y*22-rr) LDShapes.SetShapeEvent (s[y][f]) LDShapes.SetShapeEvent (h[y][f]) LDShapes.SetShapeEvent (v[y][f]) f=f+1 if dr=0 Then dww() endif endfor EndFor sub dww q[y][qq]=Shapes.AddRectangle (20 20) d[y][qq]=LDShapes.AddPolygon (dp) t[y][qq]=LDShapes.AddPolygon (dt) LDShapes.BrushColour ( q[y][qq] LDColours.HSLtoRGB (30 .7 .25)) LDShapes.BrushColour ( d[y][qq] LDColours.HSLtoRGB (30 .7 .45)) LDShapes.BrushColour ( t[y][qq] "brown") LDShapes.SetShapeEvent (q[y][qq]) LDShapes.SetShapeEvent (d[y][qq]) LDShapes.SetShapeEvent (t[y][qq]) Shapes.Move (q[y][qq] x*42+rr+p20+42+dr p300-y*22-rr-dr) Shapes.Move (d[y][qq] 20+x*42+rr+p20+42+dr p300-y*22-rr-dr) Shapes.Move (t[y][qq] x*42+rr+p20+42+dr p300-y*22-rr-dr) qq=qq+1 EndSub Sub mww zz=zz+ LDEvents.LastMouseWheelDelta /20 LDGraphicsWindow.Reposition (zz zz px py 0) EndSub End>QWD239.sb< Start>QWF512.sb< GraphicsWindow.PenWidth=0 GraphicsWindow.Title="blasting GraphicsWindow.BackgroundColor="darkblue a=1 GraphicsWindow.Height=900 GraphicsWindow.Top=0 LDPhysics.SetBoundaries (0 600 0 900) For n=-312 To 312 c=n+312' GraphicsWindow.BrushColor="black block[a] = Shapes.AddRectangle(1,n*n/220) LDPhysics.AddFixedShape(block[a],0,1) LDPhysics.SetPosition(block[a],n+312,900-n*n/440,0) EndFor LDPhysics.DoTimestep() ss=250 For n=1 To 10 GraphicsWindow.BrushColor="orange ball[n] = Shapes.AddEllipse(n/3+10,n/3+10) LDPhysics.AddMovingShape(ball[n],0,1,0) LDPhysics.SetPosition(ball[n] 300 700 0) aa=math.GetRandomNumber (180)+270 LDPhysics.SetVelocity(ball[n] ldmath.Sin(aa)*ss LDMath.Cos(aa)*ss) EndFor While 1=1 n=n+1 If Math.Remainder (n 50)=0 then LDPhysics.AddExplosion (300 700 1000 1 "white") EndIf LDPhysics.DoTimestep() Program.Delay(22) EndWhile End>QWF512.sb< Start>QWR127.sb< ' mahreen miangul ' Alphabetical Face ' FebrUary 2017 GraphicsWindow.Title = "Face" GraphicsWindow.Width = "1080" GraphicsWindow.Height = "420" GraphicsWindow.BackgroundColor = "LightYellow" GraphicsWindow.FontName = "Times New Roman" GraphicsWindow.FontSize = 120 GraphicsWindow.FontItalic = "True" GraphicsWindow.BrushColor = "Silver" ' Text shadow color GraphicsWindow.DrawText(5, 5, "mahreen miangul!") ' Shadow position/text GraphicsWindow.BrushColor = "RosyBrown" ' Text color GraphicsWindow.DrawText(0, 0, "mahreen miangul!") ' Position and text GraphicsWindow.PenWidth = 8 GraphicsWindow.PenColor = "darkslategray" GraphicsWindow.DrawEllipse(420,144,200,200) GraphicsWindow.FontName = "Roman" GraphicsWindow.FontSize = 44 GraphicsWindow.brushcolor = "sienna" GraphicsWindow.DrawBoundText(460, 170, 70, "O") GraphicsWindow.DrawBoundText(545, 170, 70, "O") GraphicsWindow.brushcolor = "peru" GraphicsWindow.DrawBoundText(500, 210, 70, "U") GraphicsWindow.brushcolor = "sandybrown" GraphicsWindow.DrawBoundText(490, 270, 70, "W") GraphicsWindow.brushcolor = "rosybrown" GraphicsWindow.DrawBoundText(398, 210, 70, "V") GraphicsWindow.DrawBoundText(606, 210, 70, "V") End>QWR127.sb< Start>QWR425.sb< GraphicsWindow.BackgroundColor="darkblue" GraphicsWindow.Width=900 GraphicsWindow.Height=900 GraphicsWindow.Title="3D WireSphere" view3D = LD3DView.AddView(900,900,"True") LD3DView.AddAmbientLight(view3D "#77777777") LD3DView.AddSpotLight (view3D,"white",1 1 1, -1,-1,1 30, 10) LD3DView.AddDirectionalLight (view3D,"#bbaaaaaa" ,30,-7,-1) LD3DView.AutoControl2 ( 1 1) r1=.1 ff="S" For v=-80 To 80 Step 10 rr=5*LDMath.Cos(v) e=5*LDMath.sin(v) i=i+1 p="" j=1 q=-Math.Remainder(i 2)*4.5 For f=0 To 360 Step 10 p=p+LDMath.Cos(f+q)*rr+":"+e+":"+LDMath.Sin(f+q)*rr+":" ndx[i][j]=LDMath.Cos(f+q)*rr ndy[i][j]=LDMath.sin(f+q)*rr ndz[i]=e j=j+1 EndFor LD3DView.AddTube(view3D p r1 8 "gold" ff) EndFor p="" For f=1 To 36 p=p+ndx[1][f]+":"+(-ndz[1])+":"+ndy[1][f]+":"+ndx[2][f]+":"+(-ndz[2])+":"+ndy[2][f]+":" EndFor p=p+ndx[1][f]+":"+(-ndz[1])+":"+ndy[1][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[1][f]+":"+ndz[1]+":"+ndy[1][f]+":"+ndx[2][f]+":"+ndz[2]+":"+ndy[2][f]+":" EndFor p=p+ndx[1][f]+":"+ndz[1]+":"+ndy[1][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[3][f]+":"+ndz[3]+":"+ndy[3][f]+":"+ndx[2][f]+":"+ndz[2]+":"+ndy[2][f]+":" EndFor p=p+ndx[3][f]+":"+ndz[3]+":"+ndy[3][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[3][f]+":"+(-ndz[3])+":"+ndy[3][f]+":"+ndx[2][f]+":"+(-ndz[2])+":"+ndy[2][f]+":" EndFor p=p+ndx[3][f]+":"+(-ndz[3])+":"+ndy[3][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[3][f]+":"+ndz[3]+":"+ndy[3][f]+":"+ndx[4][f]+":"+ndz[4]+":"+ndy[4][f]+":" EndFor p=p+ndx[3][f]+":"+ndz[3]+":"+ndy[3][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[3][f]+":"+(-ndz[3])+":"+ndy[3][f]+":"+ndx[4][f]+":"+(-ndz[4])+":"+ndy[4][f]+":" EndFor p=p+ndx[3][f]+":"+(-ndz[3])+":"+ndy[3][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[5][f]+":"+ndz[5]+":"+ndy[5][f]+":"+ndx[4][f]+":"+ndz[4]+":"+ndy[4][f]+":" EndFor p=p+ndx[5][f]+":"+ndz[5]+":"+ndy[5][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[5][f]+":"+(-ndz[5])+":"+ndy[5][f]+":"+ndx[4][f]+":"+(-ndz[4])+":"+ndy[4][f]+":" EndFor p=p+ndx[5][f]+":"+(-ndz[5])+":"+ndy[5][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[5][f]+":"+ndz[5]+":"+ndy[5][f]+":"+ndx[6][f]+":"+ndz[6]+":"+ndy[6][f]+":" EndFor p=p+ndx[5][f]+":"+ndz[5]+":"+ndy[5][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[7][f]+":"+ndz[7]+":"+ndy[7][f]+":"+ndx[6][f]+":"+ndz[6]+":"+ndy[6][f]+":" EndFor p=p+ndx[7][f]+":"+ndz[7]+":"+ndy[7][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[7][f]+":"+ndz[7]+":"+ndy[7][f]+":"+ndx[8][f]+":"+ndz[8]+":"+ndy[8][f]+":" EndFor p=p+ndx[7][f]+":"+ndz[7]+":"+ndy[7][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[9][f]+":"+ndz[9]+":"+ndy[9][f]+":"+ndx[8][f]+":"+ndz[8]+":"+ndy[8][f]+":" EndFor p=p+ndx[9][f]+":"+ndz[9]+":"+ndy[9][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[5][f]+":"+(-ndz[5])+":"+ndy[5][f]+":"+ndx[6][f]+":"+(-ndz[6])+":"+ndy[6][f]+":" EndFor p=p+ndx[5][f]+":"+(-ndz[5])+":"+ndy[5][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[7][f]+":"+(-ndz[7])+":"+ndy[7][f]+":"+ndx[6][f]+":"+(-ndz[6])+":"+ndy[6][f]+":" EndFor p=p+ndx[7][f]+":"+(-ndz[7])+":"+ndy[7][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[7][f]+":"+(-ndz[7])+":"+ndy[7][f]+":"+ndx[8][f]+":"+(-ndz[8])+":"+ndy[8][f]+":" EndFor p=p+ndx[7][f]+":"+(-ndz[7])+":"+ndy[7][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) p="" For f=1 To 36 p=p+ndx[9][f]+":"+(-ndz[9])+":"+ndy[9][f]+":"+ndx[8][f]+":"+(-ndz[8])+":"+ndy[8][f]+":" EndFor p=p+ndx[9][f]+":"+(-ndz[9])+":"+ndy[9][f] LD3DView.AddTube(view3D p r1 8 "gold" ff) For f=1 To 36 p=ndx[1][f]+":"+ndz[1]+":"+ndy[1][f]+":0:"+(ndz[1]-.1)+":0" LD3DView.AddTube(view3D p r1 8 "gold" ff) p=ndx[1][f]+":"+ndz[17]+":"+ndy[1][f]+":0:"+(ndz[17]+.1)+":0" LD3DView.AddTube(view3D p r1 8 "gold" ff) EndFor End>QWR425.sb< Start>QWT409.sb< ' SB file search program Controls.ButtonClicked=onclicked File_Open() Sub onclicked FName= program.Directory+"\"+SBName[Controls.GetTextBoxText(ctrl[2])] contents=file.ReadContents(Fname) remove() Controls.SetTextBoxText(ctrl[5],contents) GraphicsWindow.Title= SBName[Controls.GetTextBoxText(ctrl[2])] EndSub Sub remove For i=1 To 4 Controls.HideControl(ctrl[i]) EndFor EndSub Sub File_Open GraphicsWindow.Width=800 GraphicsWindow.Height=600 GraphicsWindow.BackgroundColor="Lightcyan" GraphicsWindow.BrushColor = "Black" ctrl[5] = Controls.AddMultilineTextBox(20, 20) ' FileList Box Controls.SetSize(ctrl[5], 750, 550) '------------------------------ ---------------------------------------- ctrl[1] = Shapes.AddRectangle(600, 500) ' PopUpWindow Shapes.SetOpacity(ctrl[1], 70) Shapes.Move(ctrl[1], 35, 50) '------------------------------ ---------------------------------------- GraphicsWindow.BrushColor = "White" shp[1] = Shapes.AddText("Input Load File No.... ") ' message 1 Shapes.Move(shp[1], 50, 75) '------------------------------ ---------------------------------------- GraphicsWindow.BrushColor = "Navy" ctrl[2] = Controls.AddTextBox(250, 73) ' Load FileNo input Box Controls.SetSize(ctrl[2], 100, 25) ctrl[3] = Controls.AddButton("Load_OK", 460, 73) ' Load OK ctrl[4] = Controls.AddMultilineTextBox(50, 100) ' FileList Box Controls.SetSize(ctrl[4], 550, 400) '------------------------------ ---------------------------------------- CRLF= Text.GetCharacter(13)+Text.GetCharacter(10) ' The following line could be harmful and has been automatically commented. ' All_List= File.GetFiles(Program.Directory) ' All file list D_LST="" For i=1 To Array.GetItemCount(All_List) If Text.IsSubText(All_List[i],".sb") Then NN=NN+1 NMB=10000+NN midp= Text.GetLength(Program.Directory)+2 ' \c:\desktop\.....\ *******.sb SBName[NN]=text.GetSubTextToEnd(All_List[i],midP) D_LST=D_LST+text.GetSubText(NMB,2,4)+" : "+SBName[NN]+CRLF endif EndFor Controls.SetTextBoxText(ctrl[4],D_LST) ' show SB file list endsub End>QWT409.sb< Start>QWV973.sb< GraphicsWindow.Title = "Led 8-SEG display GraphicsWindow.BackgroundColor = "teal nFrac = 6 ' number of fractional digits nExp = 2 ' number of exponential digits x = 10 ' left position for segment LED y = 10 ' top position for segment LED w = 60/1.618 ' width of one segment LED h = 60 ' height of segment LED nDigits = 15 ' 3 for a decimal point, E and two signs GraphicsWindow.Width = 2 * x + nDigits * w GraphicsWindow.Height = 300 GraphicsWindow.BrushColor = "Black" oNum = Controls.AddTextBox(x, 275) InitLED() digits = Array.GetAllIndices(seg) Stack.PushValue("local", x) For i = 1 To nDigits n = digits[i] DrawLED() x = x + w EndFor x = Stack.PopValue("local") typed = "False" Controls.TextTyped = OnTextTyped While "True" If typed Then typed = "False" num = Controls.GetTextBoxText(oNum) If num>"1e+12" Then Num2FP() DrawFP() Else DrawNum() EndIf EndIf EndWhile Sub OnTextTyped typed = "True" EndSub Sub InitLED ' return clrLED - colors for LED ' return seg - table for number to segments ' return segPos - each (relative) position of segment ' return segNames - array of segment names ' return nSegs - number of segments clrLED = "Base=darkblue;On=cyan;Off=#000077 seg[0] = "a=$;b=$;c=$;d=$;e=$;f=$ seg[1] = "b=$;c=$ seg[2] = "a=$;b=$;d=$;e=$;g=$ seg[3] = "a=$;b=$;c=$;d=$;g=$ seg[4] = "b=$;c=$;f=$;g=$ seg[5] = "a=$;c=$;d=$;f=$;g=$ seg[6] = "a=$;c=$;d=$;e=$;f=$;g=$ seg[7] = "a=$;b=$;c=$;f=$ seg[8] = "a=$;b=$;c=$;d=$;e=$;f=$;g=$ seg[9] = "a=$;b=$;c=$;d=$;f=$;g=$ seg["A"] = "a=$;b=$;c=$;e=$;f=$;g=$ seg["B"] = "c=$;d=$;e=$;f=$;g=$ seg["C"] = "a=$;d=$;e=$;f=$ seg["Cc"] = "g=$;d=$;e=$ seg["D"] = "b=$;c=$;d=$;e=$;g=$ seg["E"] = "a=$;d=$;e=$;f=$;g=$ seg["F"] = "a=$;e=$;f=$;g=$ seg["G"] = "a=$;c=$;d=$;e=$;f=$ seg["H"] = "b=$;c=$;e=$;f=$;g=$ seg["I"] = "h=$;i=$ seg["J"] = "b=$;c=$;d=$ seg["K"] = "e=$;f=$;g=$;i=$;c=$ seg["L"] = "d=$;e=$;f=$ seg["M"] = "a=$;b=$;c=$;e=$;f=$;i=$ seg["N"] = "g=$;c=$;e=$ seg["O"] = "c=$;d=$;e=$;g=$ seg["P"] = "a=$;b=$;e=$;f=$;g=$ seg["Q"] = "a=$;b=$;c=$;d=$;e=$;f=$;h=$ seg["R"] = "e=$;g=$ seg["Rr"]= "e=$;g=$;a=$;h=$;b=$;f=$ seg["S"] = "a=$;c=$;d=$;f=$;g=$;h=$ seg["T"] = "d=$;e=$;f=$;g=$ seg["U"] = "b=$;c=$;d=$;e=$;f=$ seg["V"] = "b=$;f=$;g=$;h=$ seg["W"] = "b=$;c=$;d=$;e=$;f=$;h=$ seg["X"] = "b=$;g=$;i=$;c=$;e=$ seg["Y"] = "b=$;c=$;d=$;f=$;g=$ seg["Z"] = "a=$;b=$;d=$;e=$;g=$;h=$ seg["~"] = "a=$ seg["-"] = "g=$ seg["_"] = "d=$ seg["?"] = "a=$;b=$;g=$;h=$ seg["."] = "h=$ seg["!"] = "b=$;h=$ seg["/"] = "b=$;e=$;g=$ segPos["a"] = "x=0.2;y=0.05;w=0.6;h=0.05"'top segPos["b"] = "x=0.8;y=0.1;w=0.1;h=0.375 segPos["c"] = "x=0.8;y=0.525;w=0.1;h=0.375 segPos["d"] = "x=0.2;y=0.9;w=0.6;h=0.05"'btm segPos["e"] = "x=0.1;y=0.525;w=0.1;h=0.375 segPos["f"] = "x=0.1;y=0.1;w=0.1;h=0.375 segPos["g"] = "x=0.2;y=0.475;w=0.6;h=0.05"'mid segPos["h"] = "x=0.45;y=0.525;w=0.1;h=0.375 segPos["i"] = "x=0.45;y=0.1;w=0.1;h=0.36 segNames = Array.GetAllIndices(segPos) nSegs = Array.GetItemCount(segPos) EndSub Sub DrawLED ' param x, y - position ' param w, h - size ' param n - number 0..9 Stack.PushValue("local", i) GraphicsWindow.BrushColor = clrLED["Base"] GraphicsWindow.FillRectangle(x, y, w, h) GraphicsWindow.BrushColor = clrLED["Off"] For i = 1 To nSegs If seg[n][segNames[i]]="$" Then GraphicsWindow.BrushColor = clrLED["On"] Else GraphicsWindow.BrushColor = clrLED["Off"] EndIf xs = x + segPos[segNames[i]]["x"] * w ys = y + segPos[segNames[i]]["y"] * h ws = w * segPos[segNames[i]]["w"] hs = h * segPos[segNames[i]]["h"] GraphicsWindow.FillRectangle(xs, ys, ws, hs) EndFor i = Stack.PopValue("local") EndSub Sub DrawNum ' param num len = Text.GetLength(num) ss=1 If len>nDigits*3 Then ss=len- nDigits*3 +1 endif numt=text.GetSubTextToEnd (num ss) Stack.PushValue("local", x) y=10 For yy=0 To 2 x=10 For i = 1 To nDigits n = Text.GetSubText(numt, i+yy*nDigits , 1) If n="C" Then n="cc elseIf n="R" Then n="rr EndIf DrawLED() x = x + w EndFor y=y+70 endfor x = Stack.PopValue("local") EndSub Sub DrawFP ' param fp - floating point number Stack.PushValue("local", num) num = fp DrawNum() num = Stack.PopValue("local") EndSub Sub Num2FP ' param num ' param nFrac ' param nExp ' return fp numAbs = Math.Abs(num) If numAbs <>0 then sign = num / numAbs Else sign=1 EndIf exp = Math.Floor(Math.Log(numAbs)) If Text.GetLength(Math.Abs(exp)) > nExp Then fp = "ERR2" ' Error 2 : exponential part overflow TextWindow.WriteLine("ERR2:exp=" + exp) Goto exit EndIf frac = Math.Floor(numAbs * Math.Power(10, nFrac - 1 - exp)) frac = frac / Math.Power(10, nFrac - 1) fp = (sign * frac) + "E" + exp exit: EndSub End>QWV973.sb< Start>QWX204.sb< GraphicsWindow.Show() GraphicsWindow.Height = 480 GraphicsWindow.Width = 640 z=0 For i = 1 To 1000000 'Program.Delay(250) xy = math.GetRandomNumber(100) x = Math.GetRandomNumber(640) y = Math.GetRandomNumber(480) GraphicsWindow.BrushColor = GraphicsWindow.GetRandomColor() GraphicsWindow.FillEllipse (x,y, xy, xy) GraphicsWindow.PenColor = "white" GraphicsWindow.DrawEllipse (x,y,xy,xy) z = z+1 If z=500 Then GraphicsWindow.Clear() z=0 EndIf EndFor End>QWX204.sb< Start>QXF519.sb< ' Anime Pilot - to show anime array ' Version 0.1 ' Copyright © 2019 Nonki Takahashi. The MIT License. ' Last update 2019-10-23 Init() Anime_Init() Anime_Animate() Sub Init title = "Anime Pilot - Rocket" GraphicsWindow.Title = title gw = 598 gh = 428 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.BackgroundColor = "Black" Not = "False=True;True=False;" WQ = Text.GetCharacter(34) qt = WQ CR = Text.GetCharacter(13) LF = Text.GetCharacter(10) LT = "<" UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" LOWER = "abcdefghijkomnopqrstuvwxyz" DIGIT = "0123456789" LCHAR = UPPER + LOWER + "_" TCHAR = LCHAR + DIGIT maxPalette = 32 EndSub Sub Anime_Animate t0 = Clock.ElapsedMilliseconds nP = 0 iT = 1 at = idxS[iT] cont = "True" While cont Program.Delay(100) now = Clock.ElapsedMilliseconds - t0 GraphicsWindow.Title = title + " | " + now + "[ms]" If (iT <= nT) And (at <= now) Then ' action added to process nS = Array.GetItemCount(sequence[at]) For iS = 1 To nS seq = sequence[at][iS] proc = seq proc["ts"] = at proc["te"] = at + proc["dur"] name = proc["name"] spr = sprite[name] If spr["type"] = "shp" Then Group_GetIndexOf() grp = group[i] If proc["func"] = "move" Then proc["xs"] = grp["x"] proc["ys"] = grp["y"] ElseIf proc["func"] = "rotate" Then proc["as"] = grp["angle"] EndIf Else If proc["func"] = "move" Then proc["xs"] = Shapes.GetLeft(spr["obj"]) proc["ys"] = Shapes.GetTop(spr["obj"]) ElseIf proc["func"] = "rotate" Then proc["as"] = spr["angle"] EndIf EndIf nP = nP + 1 process[nP] = proc EndFor If iT <= nT Then iT = iT + 1 at = idxS[iT] EndIf EndIf _nP = Array.GetItemCount(process) If 0 < _nP Then idxP = Array.GetAllIndices(process) nD = 0 idxD = "" For iP = 1 To _nP ' animate each process proc = process[idxP[iP]] name = proc["name"] spr = sprite[name] If spr["type"] = "shp" Then Group_GetIndexOf() EndIf If proc["te"] = proc["ts"] Then _k = 1 Else _k = (now - proc["ts"]) / (proc["te"] - proc["ts"]) If 1 < _k Then _k = 1 EndIf EndIf If proc["func"] = "move" Then x = proc["xs"] * (1 - _k) + proc["x"] * _k y = proc["ys"] * (1 - _k) + proc["y"] * _k If spr["type"] = "shp" Then Group_Move() Else Shapes.Move(spr["obj"], x, y) EndIf ElseIf proc["func"] = "rotate" Then angle = proc["as"] * (1 - _k) + proc["angle"] * _k If spr["type"] = "shp" Then Group_Rotate() Else Shapes.Rotate(spr["obj"], angle) spr["angle"] = angle sprite[proc["name"]] = spr EndIf EndIf If 1 <= _k Then nD = nD + 1 idxD[nD] = idxP[iP] EndIf EndFor For iD = 1 To nD process[idxD[iD]] = "" EndFor ElseIf nT <= iT Then cont = "False" EndIf EndWhile EndSub Sub Anime_DumpSequence nT = Array.GetItemCount(sequence) idxS = Array.GetAllIndices(sequence) For iT = 1 To nT at = idxS[iT] TextWindow.WriteLine("At " + at) seq = sequence[at] nS = Array.GetItemCount(seq) For iS = 1 To nS TextWindow.WriteLine(" " + seq[iS]) EndFor EndFor EndSub Sub Anime_Init anime = "" anime[1] = "func=load;name=Stars1;x=0;y=0;path=stars.png;" anime[2] = "func=move;name=Stars1;x=0;y=428;at=0s;dur=3s;" anime[3] = "func=move;name=Stars1;x=-598;y=0;at=3s;" anime[4] = "func=move;name=Stars1;x=0;y=0;at=6s;dur=3s;" anime[5] = "func=move;name=Stars1;x=0;y=-428;at=12s;dur=3s;" anime[6] = "func=load;name=Stars2;x=0;y=-428;path=stars.png;" anime[7] = "func=move;name=Stars2;x=0;y=0;at=0s;dur=3s;" anime[8] = "func=move;name=Stars2;x=598;y=0;at=6s;dur=3s;" anime[9] = "func=move;name=Stars2;x=0;y=428;at=9s;" anime[10] = "func=move;name=Stars2;x=0;y=0;at=12s;dur=3s;" anime[11] = "func=load;name=Rocket;x=208;y=154;path=Rocket.sb;" anime[12] = "func=move;name=Rocket;x=208;y=10;at=0s;dur=3s;" anime[13] = "func=rotate;name=Rocket;angle=-90;at=3s;dur=3s;" anime[14] = "func=rotate;name=Rocket;angle=0;at=9s;dur=3s;" anime[15] = "func=move;name=Rocket;x=208;y=154;at=12s;dur=3s;" nA = Array.GetItemCount(anime) For iA = 1 To nA anm = anime[iA] If anm["func"] = "load" Then ' load a sprite or an image from file spr = "" x = anm["x"] y = anm["y"] If Text.EndsWith(anm["path"], ".sb") Then spr["type"] = "shp" path = anm["path"] name = anm["name"] Shapes_Read() If anm["scale"] = "" Then scale = 1 Else scale = anm["scale"] EndIf Group_Add() i = nGroup Group_Move() Else spr["type"] = "img" fullPath = Program.Directory + "\" + anm["path"] spr["obj"] = Shapes.AddImage(fullPath) Shapes.Move(spr["obj"], x, y) spr["angle"] = 0 EndIf sprite[anm["name"]] = spr Else ' add action to process array buf = anm["dur"] p = 1 Parse_Time() anm["dur"] = ms buf = anm["at"] p = 1 Parse_Time() anm["at"] = ms seq = sequence[ms] nS = Array.GetItemCount(seq) seq[nS + 1] = anm sequence[ms] = seq EndIf EndFor Anime_SortSequence() EndSub Sub Anime_SortSequence nT = Array.GetItemCount(sequence) idxS = Array.GetAllIndices(sequence) For jT = 1 To nT - 1 For iT = jT + 1 To nT If idxS[iT] < idxS[jT] Then tmp = idxS[jT] idxS[jT] = idxS[iT] idxS[iT] = tmp EndIf EndFor EndFor _sequence = sequence sequence = "" For iT = 1 To nT sequence[idxS[iT]] = _sequence[idxS[iT]] EndFor EndSub Sub CS_AddColorToPalette ' Color Selector | Add color to palette ' param color - color to set ' param maxPalette ' param nPalette ' param palette ' param tPalette - target palette Stack.PushValue("local", i) For i = 1 To nPalette pltt = palette[i] If color = pltt["color"] Then Goto csactp_not_new_color EndIf EndFor pltt = palette[tPalette] pltt["color"] = color palette[tPalette] = pltt If nPalette < maxPalette Then nPalette = nPalette + 1 EndIf tPalette = tPalette + 1 If maxPalette < tPalette Then tPalette = 1 EndIf csactp_not_new_color: i = Stack.PopValue("local") EndSub Sub File_GetBasename ' FIle | Get basename from path ' param path ' return basename ' return ext - extension pPath = 1 While Text.IsSubText(Text.GetSubTextToEnd(path, pPath), "\") iBackslash = Text.GetIndexOf(Text.GetSubTextToEnd(path, pPath), "\") pPath = pPath + iBackslash EndWhile iDot = Text.GetIndexOf(Text.GetSubTextToEnd(path, pPath), ".") _iDot = iDot While 0 < _iDot _iDot = Text.GetIndexOf(Text.GetSubTextToEnd(path, pPath + iDot), ".") If 0 < _iDot Then iDot = iDot + _iDot EndIf EndWhile If 0 < iDot Then basename = Text.GetSubText(path, pPath, iDot - 1) ext = Text.GetSubTextToEnd(path, pPath + iDot) Else basename = Text.GetSubTextToEnd(path, pPath) ext = "" EndIf EndSub Sub Group_Add ' Group | add shapes to a group ' param name - group name ' param shX, shY - origin of shape array ' param scale - to resize ' param shape[] - shape array ' param nGroup - number of group ' return nGroup - updated number of group ' return group - group array Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) nGroup = nGroup + 1 grp = "" grp["name"] = name grp["x"] = shX grp["y"] = shY grp["angle"] = 0 grp["dir"] = 1 Shapes_CalcWidthAndHeight() grp["width"] = shWidth grp["height"] = shHeight grp["cx"] = shWidth / 2 grp["cy"] = shHeight / 2 s = scale grp["scale"] = s For i = 1 To Array.GetItemCount(shape) shp = shape[i] GraphicsWindow.PenWidth = shp["pw"] * s If shp["pw"] > 0 Then GraphicsWindow.PenColor = shp["pc"] EndIf If Text.IsSubText("rect|ell|tri|text|btn", shp["func"]) Then GraphicsWindow.BrushColor = shp["bc"] EndIf If Text.IsSubText("text|btn", shp["func"]) Then If silverlight Then fs = Math.Floor(shp["fs"] * 0.9) Else fs = shp["fs"] EndIf GraphicsWindow.FontSize = fs * s GraphicsWindow.FontName = shp["fn"] If shp["fb"] = "False" Then GraphicsWindow.FontBold = "False" Else GraphicsWindow.FontBold = "True" EndIf EndIf If shp["func"] = "rect" Then shp["obj"] = Shapes.AddRectangle(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "ell" Then shp["obj"] = Shapes.AddEllipse(shp["width"] * s, shp["height"] * s) ElseIf shp["func"] = "tri" Then shp["obj"] = Shapes.AddTriangle(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s, shp["x3"] * s, shp["y3"] * s) ElseIf shp["func"] = "line" Then shp["obj"] = Shapes.AddLine(shp["x1"] * s, shp["y1"] * s, shp["x2"] * s, shp["y2"] * s) ElseIf shp["func"] = "text" Then shp["obj"] = Shapes.AddText(shp["text"]) EndIf x = shp["x"] y = shp["y"] shp["rx"] = x shp["ry"] = y If sbd And (shp["func"] = "line") Then shp["wx"] = x shp["wy"] = y ElseIf silverlight And Text.IsSubText("tri|line", shp["func"]) Then _alpha = Math.GetRadians(shp["angle"]) SB_RotateWorkaround() shp["wx"] = x shp["wy"] = y EndIf If shp["func"] = "btn" Then shp["obj"] = Controls.AddButton(shp["caption"], shX + x * s, shY + y * s) Else Shapes.Move(shp["obj"], shX + x * s, shY + y * s) EndIf If Text.IsSubText("rect|ell|tri|text", shp["func"]) And (shp["angle"] <> 0) And (shp["angle"] <> "") Then Shapes.Rotate(shp["obj"], shp["angle"]) EndIf shape[i] = shp EndFor grp["shape"] = shape group[nGroup] = grp y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub Sub Group_GetIndexOf ' Group | get index of a group ' param name - a group name ' return i - index of the group i = 0 ' not found For _i = 1 To nGroup grp = group[_i] If grp["name"] = name Then i = _i _i = nGroup ' exit For EndIf EndFor EndSub Sub Group_Move ' Group | move a group ' param group[i] - group To move ' param x, y - position To move ' return group[i] - updated group Stack.PushValue("local", j) grp = group[i] s = grp["scale"] grp["x"] = x grp["y"] = y shape = grp["shape"] n = Array.GetItemCount(shape) For j = 1 To n shp = shape[j] If sbd And (shp["func"] = "line") Then _x = shp["wx"] _y = shp["wy"] ElseIf silverlight And Text.IsSubText("tri|line", shp["func"]) Then _x = shp["wx"] _y = shp["wy"] Else _x = shp["rx"] _y = shp["ry"] EndIf Shapes.Move(shp["obj"], grp["x"] + _x * s, grp["y"] + _y * s) EndFor group[i] = grp j = Stack.PopValue("local") EndSub Sub Group_Rotate ' Group | rotate a group ' param group[i] - group to move ' param cx, cy - rotation center (if given) ' param angle - to rotate Stack.PushValue("local", x) Stack.PushValue("local", y) Stack.PushValue("local", n) grp = group[i] shape = grp["shape"] moved = "False" If cx <> "" Then moved = "True" Else cx = "" ' to avoid syntax error EndIf If cy <> "" Then moved = "True" Else cy = "" ' to avoid syntax error EndIf If moved Then param["x"] = grp["x"] param["y"] = grp["y"] param["cx"] = cx param["cy"] = cy param["width"] = grp["width"] param["height"] = grp["height"] param["scale"] = 1 param["angle"] = angle Shapes_CalcRotateZoomPos() grp["x"] = x grp["y"] = y EndIf param["cx"] = grp["width"] / 2 param["cy"] = grp["height"] / 2 param["scale"] = grp["scale"] grp["angle"] = angle param["angle"] = grp["angle"] n = Array.GetItemCount(shape) Stack.PushValue("local", i) For i = 1 To n shp = shape[i] param["x"] = shp["x"] param["y"] = shp["y"] param["width"] = shp["width"] param["height"] = shp["height"] Shapes_CalcRotateZoomPos() shp["rx"] = x shp["ry"] = y alpha = shp["angle"] + grp["angle"] If sbd And (shp["func"] = "line") And (alpha <> 0) Then x1 = shp["x1"] y1 = shp["y1"] x2 = shp["x2"] y2 = shp["y2"] pw = shp["pw"] SB_LineWorkaround() shp["wx"] = x shp["wy"] = y ElseIf silverlight And Text.IsSubText("tri|line", shp["func"]) Then _alpha = Math.GetRadians(alpha) SB_RotateWorkAround() shp["wx"] = x shp["wy"] = y EndIf Shapes.Move(shp["obj"], grp["x"] + x, grp["y"] + y) Shapes.Rotate(shp["obj"], shp["angle"] + grp["angle"]) shape[i] = shp EndFor i = Stack.PopValue("local") grp["shape"] = shape group[i] = grp n = Stack.PopValue("local") y = Stack.PopValue("local") x = Stack.PopValue("local") EndSub Sub Math_CartesianToPolar ' Math | convert cartesian coodinate to polar coordinate ' param x, y - cartesian coordinate ' return r, a - polar coordinate r = Math.SquareRoot(x * x + y * y) If x = 0 And y > 0 Then a = 90 ' [degree] ElseIf x = 0 And y < 0 Then a = -90 Else a = Math.ArcTan(y / x) * 180 / Math.Pi EndIf If x < 0 Then a = a + 180 ElseIf x > 0 And y < 0 Then a = a + 360 EndIf EndSub Sub Parse_Angle ' param attr["transform"] - transform attribute in tag ' return angle - angle angle = "" If attr["transform"] <> "" Then pAngle = 8 lAngle = Text.GetIndexOf(Text.GetSubTextToEnd(attr["transform"], pAngle), " ") - 1 angle = Text.GetSubText(attr["transform"], pAngle, lAngle) EndIf EndSub Sub Parse_CalcDetectBorder ' param i - index of shapes shp = shape[i] If shp["func"] = "line" Then ' line x = shp["x2"] - shp["x1"] y = shp["y2"] - shp["y1"] Math_CartesianToPolar() If 180 <= a Then a = a - 180 EndIf shp["angle"] = a cx = shp["x"] + Math.Abs(x) / 2 cy = shp["y"] + Math.Abs(y) / 2 len = Math.SquareRoot(x * x + y * y) shp["_x0"] = Math.Floor(cx - len / 2) shp["_x1"] = Math.Floor(cx + len / 2) shp["_y0"] = cy - 4 shp["_y1"] = cy + 4 Else ' rectangle, ellipse or triangle If shp["func"] = "tri" Then ' triangle shp["width"] = shp["x3"] shp["height"] = shp["y2"] EndIf shp["_x0"] = shp["x"] shp["_y0"] = shp["y"] shp["_x1"] = shp["x"] + shp["width"] shp["_y1"] = shp["y"] + shp["height"] EndIf shape[i] = shp EndSub Sub Parse_Defs ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "defs>") Then Stack.PushValue("local", p) p = p + 6 Parse_Space() match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "g id=" + WQ + "g1" + WQ + ">") Then p = p + 11 match = "True" EndIf _p = Stack.PopValue("local") If Not[match] Then p = _p EndIf EndIf EndSub Sub Parse_Ellipse ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match ' return shp - shape entry match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "ellipse") Then param = "tag=ellipse;" Parse_FindTag() ' p is updated Parse_GetAttrAndText() cx = attr["cx"] cy = attr["cy"] rx = attr["rx"] ry = attr["ry"] Parse_SetStyle() Parse_Angle() shp = "" shp["func"] = "ell" shp["x"] = cx - rx - Math.Floor(pw / 2) shp["y"] = cy - ry - Math.Floor(pw / 2) shp["width"] = 2 * rx + pw shp["height"] = 2 * ry + pw shp["angle"] = angle shp["pw"] = pw shp["pc"] = pc shp["bc"] = bc match = "True" EndIf EndSub Sub Parse_FindTag ' find tag from html buffer ' param["tag"] - tag name ' param["class"] - class name ' param p - pointer for buffer ' param buf - html buffer ' return tag - found tag pSave = p tag = "" findNext = "True" While findNext findNext = "False" ' tag may be not found pTag = Text.GetIndexOf(Text.GetSubTextToEnd(buf, p), LT + param["tag"]) If 0 < pTag Then lTag = Text.GetLength(param["tag"]) + 1 pTag = p + pTag - 1 len = Text.GetIndexOf(Text.GetSubTextToEnd(buf, pTag), "/" + param["tag"] + ">") If len = 0 Then lTag = 1 len = Text.GetIndexOf(Text.GetSubTextToEnd(buf, pTag), "/>") EndIf If param["class"] = "" Then len = len + lTag tag = Text.GetSubText(buf, pTag, len) findNext = "False" ' found the tag ElseIf 0 < len Then findNext = "True" ' tag may have different class len = len + lTag attr = "class=" + qt + param["class"] + qt pAttr = pTag + lTag + 1 lAttr = Text.GetLength(attr) If Text.GetSubText(buf, pAttr, lAttr) = attr Then tag = Text.GetSubText(buf, pTag, len) findNext = "False" ' found the tag EndIf EndIf p = pTag + len EndIf EndWhile If tag = "" Then p = pSave EndIf EndSub Sub Parse_GetAttrAndText ' get attributes and text from given tag ' param tag - given tag ' return attr[] - array of attributes in the tag ' return txt - text in the tag ' return len - length of the tag pTag = Text.GetIndexOf(tag, " ") + 1 pEnd = Text.GetIndexOf(tag, ">") attr = "" While pTag <= pEnd Parse_SkipSpaceInTag() pEq = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), "=") If 0 < pEq Then pEq = pTag + pEq - 1 If Text.GetSubText(tag, pEq + 1, 1) = qt Then pQ = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pEq + 2), qt) If 0 < pQ Then pQ = pEq + 2 + pQ - 1 attr[Text.GetSubText(tag, pTag, pEq - pTag)] = Text.GetSubText(tag, pEq + 2, pQ - pEq - 2) pTag = pQ + 2 EndIf EndIf Else pTag = pEnd + 1 EndIf EndWhile If pEnd + 1 < pTag Then pTag = pEnd + 1 EndIf len = Text.GetLength(tag) txt = "" While pTag <= len pL = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), LT) If pL = 0 Then txt = Text.Append(txt, Text.GetSubTextToEnd(tag, pTag)) pTag = len + 1 Else pL = pTag + pL - 1 txt = Text.Append(txt, Text.GetSubText(tag, pTag, pL - pTag)) pR = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), ">") If 0 < pR Then pTag = pTag + pR Else pTag = len + 1 EndIf EndIf EndWhile EndSub Sub Parse_GetStyleAttr ' param kw - keyword ' param attr["style"] - style attribute ' param pStyle - pointer to search in style attribute ' return value - value pKw = Text.GetIndexOf(Text.GetSubTextToEnd(attr["style"], pStyle), kw) If pKw = 0 Then value = "" Else pValue = pStyle + pKw + Text.GetLength(kw) pColon = Text.GetIndexOf(Text.GetSubTextToEnd(attr["style"], pValue), ";") If pColon = 0 Then pColon = Text.GetLength(kw) + 1 EndIf value = Text.GetSubText(attr["style"], pValue, pColon - 1) EndIf EndSub Sub Parse_Header ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match ' return shp - shape entry If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "svg") Then len = Text.GetIndexOf(Text.GetSubTextToEnd(buf, p), ">") If 0 < len Then tag = Text.GetSubText(buf, p, len) Parse_GetAttrAndText() width = attr["width"] height = attr["height"] p = p + len match = "True" EndIf EndIf EndSub Sub Parse_Line ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match ' return shp - shape entry match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "line") Then param = "tag=line;" Parse_FindTag() ' p is updated Parse_GetAttrAndText() Parse_SetStyle() points = attr["x1"] + "," + attr["y1"] + " " + attr["x2"] + "," + attr["y2"] Parse_Points() shp = "" shp["func"] = "line" shp["x"] = x shp["y"] = y shp["width"] = width shp["height"] = height shp["x1"] = px[1] - x shp["y1"] = py[1] - y shp["x2"] = px[2] - x shp["y2"] = py[2] - y shp["pw"] = pw shp["pc"] = pc match = "True" EndIf EndSub Sub Parse_Num ' param buf - buffert to parse ' param p - pointer to the buffer ' return _num - number ' return match - "True" if match _c = Text.GetSubText(buf, p, 1) _num = "" match = "False" While Text.IsSubText(DIGIT, _c) match = "True" _num = Text.Append(_num, _c) p = p + 1 _c = Text.GetSubText(buf, p, 1) EndWhile EndSub Sub Parse_Points ' param points - points in a polygon ' return px[], py[] - array of the points ' return x, y - left top of the points ' return width, height - size of the polygon len = Text.GetLength(points) px = "" py = "" nPoints = 1 For pPoints = 1 To len c = Text.GetSubText(points, pPoints, 1) While (pPoints <= len) And Text.IsSubText(DIGIT, c) px[nPoints] = Text.Append(px[nPoints], c) pPoints = pPoints + 1 c = Text.GetSubText(points, pPoints, 1) EndWhile If c = "," Then pPoints = pPoints + 1 c = Text.GetSubText(points, pPoints, 1) EndIf While (pPoints <= len) And Text.IsSubText(DIGIT, c) py[nPoints] = Text.Append(py[nPoints], c) pPoints = pPoints + 1 c = Text.GetSubText(points, pPoints, 1) EndWhile If nPoints = 1 Then xmin = px[1] ymin = py[1] xmax = px[1] ymax = py[1] Else If px[nPoints] < xmin Then xmin = px[nPoints] EndIf If py[nPoints] < ymin Then ymin = py[nPoints] EndIf If xmax < px[nPoints] Then xmax = px[nPoints] EndIf If ymax < py[nPoints] Then ymax = py[nPoints] EndIf EndIf If c = " " Then nPoints = nPoints + 1 EndIf EndFor x = xmin y = ymin width = xmax - xmin height = ymax - ymin EndSub Sub Parse_Polygon ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match ' return shp - shape entry match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "polygon") Then param = "tag=polygon;" Parse_FindTag() ' p is updated Parse_GetAttrAndText() points = attr["points"] Parse_Points() Parse_SetStyle() Parse_Angle() shp = "" shp["func"] = "tri" shp["x"] = x shp["y"] = y shp["width"] = width shp["height"] = height shp["angle"] = angle shp["x1"] = px[1] - x shp["y1"] = py[1] - y shp["x2"] = px[2] - x shp["y2"] = py[2] - y shp["x3"] = px[3] - x shp["y3"] = py[3] - y shp["pw"] = pw shp["pc"] = pc shp["bc"] = bc match = "True" EndIf EndSub Sub Parse_Rect ' param buf - SVG buffer ' param p - pointer to SVG buffer ' return match - "True" if match ' return shp - shape entry match = "False" If Text.StartsWith(Text.GetSubTextToEnd(buf, p), LT + "rect") Then param = "tag=rect;" Parse_FindTag() ' p is updated Parse_GetAttrAndText() x = attr["x"] y = attr["y"] width = attr["width"] height = attr["height"] Parse_SetStyle() Parse_Angle() shp = "" shp["func"] = "rect" shp["x"] = x - Math.Floor(pw / 2) shp["y"] = y - Math.Floor(pw / 2) shp["width"] = width + pw shp["height"] = height + pw shp["angle"] = angle shp["pw"] = pw shp["pc"] = pc shp["bc"] = bc match = "True" EndIf EndSub Sub Parse_SetStyle pStyle = 1 kw = "fill" Parse_GetStyleAttr() bc = Text.ConvertToUpperCase(value) kw = "stroke" Parse_GetStyleAttr() pc = Text.ConvertToUpperCase(value) kw = "stroke-width" Parse_GetStyleAttr() pw = value EndSub Sub Parse_SB subname = "Shapes_Init_" + name filename = Program.Directory + "\" + path buf = "" SB_AppendSub() ptr = Text.GetIndexOf(buf, "Sub " + subname) If ptr = 0 Then Goto rs_exit EndIf ' Parse "shX = ..." _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shX = ") If _ptr = 0 Then Goto rs_exit EndIf shX = "" ptr = ptr + _ptr + 5 c = Text.GetSubText(buf, ptr, 1) While Text.GetIndexOf("0123456789", c) > 0 shX = Text.Append(shX, c) ptr = ptr + 1 c = Text.GetSubText(buf, ptr, 1) EndWhile ' Parse "shY = ..." _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shY = ") If _ptr = 0 Then Goto rs_exit EndIf shY = "" ptr = ptr + _ptr + 5 c = Text.GetSubText(buf, ptr, 1) While Text.GetIndexOf("0123456789", c) > 0 shY = Text.Append(shY, c) ptr = ptr + 1 c = Text.GetSubText(buf, ptr, 1) EndWhile ' Parse "shape[i] = ..." While "True" _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shape[") If _ptr = 0 Then Goto rs_exit EndIf ptr = ptr + _ptr + 5 _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "] = " + WQ) If _ptr = 0 Then Goto rs_exit EndIf i = Text.GetSubText(buf, ptr, _ptr - 1) If (i * 1) <> (i + 0) Then ' i is not number Goto rs_exit EndIf ptr = ptr + _ptr + 4 _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), WQ) If _ptr = 0 Then Goto rs_exit EndIf shape[nShapes + i] = Text.GetSubText(buf, ptr, _ptr - 1) ptr = ptr + _ptr EndWhile rs_exit: iMin = nShapes + 1 nShapes = Array.GetItemCount(shape) iMax = nShapes For i = iMin To iMax shp = shape[i] If shp["func"] = "tri" And (shp["y2"] < shp["y1"]) Then shp["y2"] = shp["y1"] shp["y1"] = shp["y3"] shp["y3"] = shp["y2"] shp["angle"] = shp["angle"] + 180 If shp["angle"] >= 360 Then shp["angle"] = shp["angle"] - 360 EndIf EndIf shape[i] = shp Parse_CalcDetectBorder() If shp["pc"] <> "" Then color = shp["pc"] CS_AddColorToPalette() EndIf If shp["bc"] <> "" Then color = shp["bc"] CS_AddColorToPalette() EndIf EndFor scale = 1 EndSub Sub Parse_SkipSpaceInTag ' param pTag - pointer to tag ' param tag - tag ' return pTag - updated pointer to tag isSpace = "True" While isSpace char = Text.GetSubText(tag, pTag, 1) If Text.IsSubText(" " + CR + LF, char) Then pTag = pTag + 1 Else isSpace = "False" EndIf EndWhile EndSub Sub Parse_Space ' param p - pointer to buffer ' param buf - buffer ' return p - updated pointer to buffer isSpace = "True" While isSpace char = Text.GetSubText(buf, p, 1) If Text.IsSubText(" " + CR + LF, char) Then p = p + 1 Else isSpace = "False" EndIf EndWhile EndSub Sub Parse_SVG ' param buf - SVG buffer scale = 1 iMin = nShapes + 1 iMax = nShapes p = 1 Parse_Header() Parse_Space() Parse_Defs() While match Parse_Space() Parse_Rect() If match Then iMax = iMax + 1 shape[iMax] = shp EndIf If Not[match] Then Parse_Ellipse() If match Then iMax = iMax + 1 shape[iMax] = shp EndIf EndIf If Not[match] Then Parse_Polygon() If match Then iMax = iMax + 1 shape[iMax] = shp EndIf EndIf If Not[match] Then Parse_Line() If match Then iMax = iMax + 1 shape[iMax] = shp EndIf EndIf EndWhile nShapes = iMax Parse_Use() EndSub Sub Parse_Time ' param buf - the buffer to parse ' param p - point to the buffer ' return ms - duration [ms] 'lenBuf = Text.GetLength(buf) ms = "" value = "" nValue = 0 Parse_Num() If match Then nValue = nValue + 1 value[nValue] = _num If Text.GetSubText(buf, p, 1) = ":" Then p = p + 1 While match Parse_Num() If match Then nValue = nValue + 1 value[nValue] = _num If Text.GetSubText(buf, p, 1) = ":" Then p = p + 1 Else match = "False" EndIf EndIf EndWhile If Text.GetSubText(buf, p, 1) = "." Then p = p + 1 Parse_Num() If match Then nValue = nValue + 1 value[nValue] = _num ms = value[nValue] nValue = nValue - 1 Else ms = 0 EndIf EndIf k = "1=1000;2=60000;3=3600000;" iK = 1 For iV = nValue To 1 Step -1 ms = ms + k[iK] * value[iV] EndFor ElseIf Text.GetSubTextToEnd(buf, p) = "h" Then ms = _num * 3600000 ElseIf Text.GetSubTextToEnd(buf, p) = "m" Then ms = _num * 60000 ElseIf Text.GetSubTextToEnd(buf, p) = "s" Then ms = _num * 1000 ElseIf Text.GetSubTextToEnd(buf, p) = "ms" Then ms = _num EndIf EndIf EndSub Sub Parse_Use param = "tag=use;" Parse_FindTag() ' p is updated Parse_GetAttrAndText() shX = 0 shY = 0 For i = iMin To iMax shp = shape[i] shp["x"] = shp["x"] + attr["x"] shp["y"] = shp["y"] + attr["y"] If shp["func"] = "tri" And (shp["y2"] < shp["y1"]) Then shp["y2"] = shp["y1"] shp["y1"] = shp["y3"] shp["y3"] = shp["y2"] shp["angle"] = shp["angle"] + 180 If 360 <= shp["angle"] Then shp["angle"] = shp["angle"] - 360 EndIF EndIf If shp["pc"] <> "" Then color = shp["pc"] CS_AddColorToPalette() EndIf If shp["bc"] <> "" Then color = shp["bc"] CS_AddColorToPalette() EndIf shape[i] = shp Parse_CalcDetectBorder() EndFor EndSub Sub SB_AppendSub ' Small Basic | Append subroutine from Small Basic source file ' param filename - file name ' param subname - subroutine name ' return buf - subroutine buffer If "False" Then subname = subname ' to avoid syntax error filename = filename ' to avoid syntax error EndIf len = Text.GetLength(subname) _buf = "" ' for Slilverlight ' The following line could be harmful and has been automatically commented. ' _buf = File.ReadContents(filename) ptr = 1 notFound = "True" While notFound _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(_buf, ptr), "Sub") If _ptr = 0 Then _buf = "" Goto sbas_exit EndIf ptrSub = ptr + _ptr - 1 ptr = ptrSub + 3 While Text.GetSubText(_buf, ptr, 1) = " " ptr = ptr + 1 EndWhile If Text.GetSubText(_buf, ptr, len) = subname And Text.IsSubText(TCHAR, Text.GetSubText(_buf, ptr + len, 1)) = "False" Then notFound = "False" EndIf EndWhile _ptre = _ptr - 1 _ptrq = _ptr While (0 < _ptrq) And (_ptre < _ptrq) ' EOL exists before single quote (comment) _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(_buf, ptr), "EndSub") If _ptr = 0 Then buf = "" Goto sbas_exit EndIf _ptre = ptr + _ptr - 3 While (1 <= _ptre) And (Text.GetSubText(_buf, _ptre, 2) <> CR + LF) _ptre = _ptre - 1 EndWhile _ptrq = ptr + _ptr - 2 While (1 <= _ptrq) And (Text.GetSubText(_buf, _ptrq, 1) <> "'") _ptrq = _ptrq - 1 EndWhile If (0 < _ptrq) And (_ptre < _ptrq) Then ptr = ptr + _ptr + 5 EndIf EndWhile ptrEndSub = ptr + _ptr - 1 ptr = ptrEndSub + 6 len = ptr - ptrSub buf = buf + Text.GetSubText(_buf, ptrSub, len) sbas_exit: EndSub Sub SB_LineWorkaround ' Small Basic | line rotate workaround for SBD ' param x, y - coordinate of the position of the line ' param x1, y1 - coordinate of the first point ' param x2, y2 - coordinate of the second point ' param pw - pen width ' param alpha - to rotate [degree] ' return x, y - workaround value for the coordinate Stack.PushValue("local", x) Stack.PushValue("local", y) x = x1 - x2 y = y1 - y2 Math_CartesianToPolar() y = Stack.PopValue("local") x = Stack.PopValue("local") _a = Math.GetRadians(a) _alpha = Math.GetRadians(a - alpha) Δx = pw / 4 * (Math.Sin(_alpha) - Math.Sin(_a)) Δy = pw / 4 * (Math.Cos(_alpha) - Math.Cos(_a)) x = x - Δx y = y - Δy EndSub Sub SB_RotateWorkaround ' Small Basic | Rotate workaround for Silverlight ' param x, y - original coordinate ' param _alpha - angle [radian] ' returns x, y - workaround coordinate If shape[i]["func"] = "tri" Then x1 = -Math.Floor(shape[i]["x3"] / 2) y1 = -Math.Floor(shape[i]["y3"] / 2) ElseIf shape[i]["func"] = "line" Then x1 = -Math.Floor(Math.Abs(shape[i]["x1"] - shape[i]["x2"]) / 2) y1 = -Math.Floor(Math.Abs(shape[i]["y1"] - shape[i]["y2"]) / 2) EndIf ox = x - x1 oy = y - y1 x = x1 * Math.Cos(_alpha) - y1 * Math.Sin(_alpha) + ox y = x1 * Math.Sin(_alpha) + y1 * Math.Cos(_alpha) + oy EndSub Sub SB_Workaround ' Small Basic | workaround for Silverlight / SBD ' return silverlight - "True" if in remote ' return sbd - "True" if Small Basic Desktop color = GraphicsWindow.GetPixel(0, 0) sbd = "False" If Text.GetLength(color) > 7 Then silverlight = "True" msWait = 300 Else silverlight = "False" _gw = GraphicsWindow.Width _gh = GraphicsWindow.Height If (_gw = 624) And (_gh = 441) Then sbd = "True" EndIf EndIf EndSub Sub Shapes_CalcRotatePos2 param = "" ' Shapes | Calculate position for rotated shape ' param["x"], param["y"] - position of a shape ' param["width"], param["height"] - size of a shape ' param ["cx"], param["cy"] - center of rotation ' param ["angle"] - rotate angle ' return x, y - rotated position of a shape _cx = param["x"] + param["width"] / 2 _cy = param["y"] + param["height"] / 2 x = _cx - param["cx"] y = _cy - param["cy"] Math_CartesianToPolar() a = a + param["angle"] x = r * Math.Cos(a * Math.Pi / 180) y = r * Math.Sin(a * Math.Pi / 180) _cx = x + param["cx"] _cy = y + param["cy"] x = _cx - param["width"] / 2 y = _cy - param["height"] / 2 EndSub Sub Shapes_CalcRotateZoomPos ' Shapes | calculate position for rotated and zoomed shape ' param["x"], param["y"] - position of a shape ' param["width"], param["height"] - size of a shape ' param ["cx"], param["cy"] - center of rotation ' param ["angle"] - rotate angle ' param ["scale"] - zoom scale ' return x, y - rotated position of a shape _cx = param["x"] + param["width"] / 2 _cy = param["y"] + param["height"] / 2 x = _cx - param["cx"] y = _cy - param["cy"] Math_CartesianToPolar() a = a + param["angle"] x = r * Math.Cos(a * Math.Pi / 180) * param["scale"] y = r * Math.Sin(a * Math.Pi / 180) * param["scale"] _cx = x + param["cx"] _cy = y + param["cy"] x = _cx - param["width"] / 2 y = _cy - param["height"] / 2 EndSub Sub Shapes_CalcWidthAndHeight ' Shapes | calculate total width and height of shapes ' param shape[] - shape array ' return shWidth, shHeight - total size of shapes For i = 1 To Array.GetItemCount(shape) shp = shape[i] If shp["func"] = "tri" Or shp["func"] = "line" Then xmin = shp["x1"] xmax = shp["x1"] ymin = shp["y1"] ymax = shp["y1"] If shp["x2"] < xmin Then xmin = shp["x2"] EndIf If xmax < shp["x2"] Then xmax = shp["x2"] EndIf If shp["y2"] < ymin Then ymin = shp["y2"] EndIf If ymax < shp["y2"] Then ymax = shp["y2"] EndIf If shp["func"] = "tri" Then If shp["x3"] < xmin Then xmin = shp["x3"] EndIf If xmax < shp["x3"] Then xmax = shp["x3"] EndIf If shp["y3"] < ymin Then ymin = shp["y3"] EndIf If ymax < shp["y3"] Then ymax = shp["y3"] EndIf EndIf shp["width"] = xmax - xmin shp["height"] = ymax - ymin EndIf If i = 1 Then shWidth = shp["x"] + shp["width"] shHeight = shp["y"] + shp["height"] Else If shWidth < shp["x"] + shp["width"] Then shWidth = shp["x"] + shp["width"] EndIf If shHeight < shp["y"] + shp["height"] Then shHeight = shp["y"] + shp["height"] EndIf EndIf shape[i] = shp EndFor EndSub Sub Shapes_DumpArray ' Shapes | dump shapes data order = "1=func;2=x;3=y;4=width;5=height;6=x1;7=y1;8=x2;9=y2;" order = order + "10=x3;11=y3;12=txt;13=fn;14=fs;15=fb;16=fi;" order = order + "17=angle;18=pw;19=pc;20=bc;" nOrder = Array.GetItemCount(order) WQ = Text.GetCharacter(34) LF = Text.GetCharacter(10) gw = GraphicsWindow.Width gh = GraphicsWindow.Height GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Consolas" GraphicsWindow.FontSize = 14 tbox = Controls.AddMultiLineTextBox(gw / 2, 10) Controls.SetSize(tbox, gw / 2 - 10, gh - 20) buf = " shX = " + shX + " ' x offset" + LF buf = buf + " shY = " + shY + " ' y offset" + LF buf = buf + " shape = " + WQ + WQ + LF For i = 1 To Array.GetItemCount(shape) buf = buf + " shape[" + i + "] = " + WQ shp = shape[i] For j = 1 To nOrder If shp[order[j]] <> "" Then buf = buf + order[j] + "=" + shp[order[j]] + ";" EndIf EndFor buf = buf + WQ + LF EndFor Controls.SetTextBoxText(tbox, buf) Shapes.SetOpacity(tbox, 50) EndSub Sub Shapes_Read ' Shapes | read shapes data from sprite file ' param path - sprite file path ' param name - sprite name ' The following line could be harmful and has been automatically commented. ' buf = File.ReadContents(Program.Directory + "\" + path) If buf <> "" Then File_GetBasename() lowerExt = Text.ConvertToLowerCase(ext) Stack.PushValue("local", pw) If lowerExt = "svg" Then Parse_SVG() ElseIf (lowerExt = "sb") Or (lowerExt = "smallbasic") Then Parse_SB() EndIf pw = Stack.PopValue("local") EndIf EndSub End>QXF519.sb< Start>QXG820.sb< '============================================================================= ' HISTOGRAM OF DICE THROWS - WITH SCALING DEPENDING ON GW SIZE AND THROW COUNT '============================================================================= 'Setup GraphicsWindow gw = 12*50 'Some multiple of 12 works well since there will be 11+1(scale) columns gh = 600 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Left = (Desktop.Width-gw)/2 GraphicsWindow.Top = 10 GraphicsWindow.CanResize = "False" GraphicsWindow.BackgroundColor = "AliceBlue" numThrow = 1000 'Number of dice throws - will affect vertical scaling of the histogram Xaxis = 30 'pixels above window bottom for X axis rad = 4 'Expected frequency blob size 'Frequency ratios - expected proportion for each score - solution to text problem 5.2 freq = "" For i = 1 To 6 For j = 1 To 6 freq[i+j] = freq[i+j] + 1/36 EndFor EndFor While ("True") 'Keep repeating 'Setup display and histogram axes GraphicsWindow.Clear() GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText((gw-260)/2,10,"Frequency of "+numThrow+" random dice pair throws") 'Roughly centre this text GraphicsWindow.PenWidth = 0.1 pixelScale = 4*gh/numThrow 'Vertical pixels per frequency count - to fit histogram on window 'Vertical left axis For j = 0 To numThrow/5 Step numThrow/100 ' 20 scale points on the left axis GraphicsWindow.DrawText(5,gh-Xaxis-8-pixelScale*j,j) GraphicsWindow.DrawLine(gw/12,gh-Xaxis-pixelScale*j,12*gw/12,gh-Xaxis-pixelScale*j) EndFor 'Bottom axis For j = 2 To 12 x = (j-1)/12*gw GraphicsWindow.DrawText(x+gw/35,gh-Xaxis/2,j) EndFor 'Expected value blobs GraphicsWindow.BrushColor = "Red" For i = 2 To 12 blob[i] = Shapes.AddEllipse(2*rad,2*rad) EndFor 'Do the simulation score = "" For i = 1 To numThrow dice1 = Math.GetRandomNumber(6) dice2 = Math.GetRandomNumber(6) total = dice1+dice2 score[total] = score[total]+1 updatePlot() EndFor Program.Delay(1000) EndWhile Sub updatePlot GraphicsWindow.BrushColor = "SlateGray" 'For histogram For j = 2 To 12 x = (j-1)*gw/12 y = pixelScale*score[j] 'Vertical scaling depending on window size and number of throws GraphicsWindow.FillRectangle(x,gh-Xaxis-y,gw/12-2,y) 'Move expetation blobs Shapes.Move(blob[j],x+gw/24-rad,gh-Xaxis-pixelScale*i*freq[j]-rad) EndFor 'Counter update GraphicsWindow.BrushColor = GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle(gw-70,10,100,20) GraphicsWindow.BrushColor = "Black" GraphicsWindow.DrawText(gw-70,10,i) EndSub End>QXG820.sb< Start>QXH159.sb< 'Author: Gunnar 'This is a solution to the Euler Project Problem 28. 'This program solves the problem by viewing the diagonals 'as four different sequences of numbers. sum = 0 For i = 1 To 501 '(There are 501 numbers in every sequence.) ur = 4 * i*i - 4 * i + 1 'Sequence from middle to the upper right ul = 4 * i*i - 6 * i + 3 'Sequence from middle to the upper left lr = 4 * i*i - 10 * i + 7 'Sequence from middle to the lower right ll = 4 * i*i - 8 * i + 5 'Sequence from middle to the lower left sum = sum + ur + ul + lr + ll 'The sum of the numbers EndFor sum = sum - 3 'The 1 in the middle should only be counted once. TextWindow.WriteLine("Sum is: " + sum) End>QXH159.sb< Start>QXK334.sb< ' Shapes 1.42 ' Copyright (c) 2012 Nonki Takahashi. All rights reserved. ' ' History : ' 1.42 2012/10/16 Minor bug fixed - open message remains. (TLW744-2) ' 1.41 2012/10/16 Minor bug fixed - line rotated. (TLW744-1) ' 1.4 2012/10/16 Supported cursor keys and new UI for shapes menu. (XFZ657-14) ' 1.31 2012/09/20 Minor bug fixed - pinches removed at consecutive shapes addition. (TLW744-0) ' 1.3 2012/09/20 Supported palette loading , consecutive shapes addition and (2). (XFZ657-13) ' 1.2 2012/09/20 Bug fixed (1) and supported short cut keys. (XFZ657-12) ' 1.12 2012/09/18 Bug fixed (select line from file). (XFZ657-11) ' 1.1 2012/09/18 Supported file input. (TLW744) ' 1.0 2012/09/15 Supported copy and paste. (XFZ657-10) ' ' Bug fix : ' (1) No rotation frame after paste ' (2) Pinches came under a shape after pen or brush color change ' title = "Shapes 1.42" GraphicsWindow.Title = title debug = "False" WQ = Text.GetCharacter(34) CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) CS_InitPalette() ' initialize palette for color slider DrawMenu() shape = "" nShapes = 0 cont = "True" ' continue Mouse_Init() KB_Init() param = "down=True;move=False;up=True;" ' wait to click Mouse_SetHandler() While cont If clicked Then ' mouse clicked DetectClickedObject() DoObject() param = "down=True;move=False;up=True;" Mouse_SetHandler() ElseIf in > out Then ' key input buffer is not empty KB_InKey() If c = "^x" Then obj = "menu" + icut DoMenu() ElseIf c = "^c" Then obj = "menu" + icopy DoMenu() ElseIf c = "^v" Then obj = "menu" + ipaste DoMenu() ElseIf c = "DEL" Then If selectedshape <> "" Then DeleteSelectedShape() i = selectedshape select = "False" ShapeSelect() ' removes pinches EndIf ElseIf c = "LEFT" Or c = "RIGHT" Or c = "UP" Or c="DOWN" Then If selectedshape <> "" Then i = selectedshape _x = shape[i]["x"] + arrow_dx[c] _y = shape[i]["y"] + arrow_dy[c] MoveShape() EndIf EndIf param = "down=True;move=False;up=True;" Mouse_SetHandler() Else Program.Delay(100) EndIf EndWhile ' end of program Sub CalcDetectBorder ' param i - index of shapes If shape[i]["func"] = "line" Then ' line x = shape[i]["x2"] - shape[i]["x1"] y = shape[i]["y2"] - shape[i]["y1"] Math_CartesianToPolar() If a >= 180 Then a = a - 180 EndIf shape[i]["angle"] = a cx = shape[i]["x"] + Math.Abs(x) / 2 cy = shape[i]["y"] + Math.Abs(y) / 2 len = Math.SquareRoot(x * x + y * y) shape[i]["_x0"] = Math.Floor(cx - len / 2) shape[i]["_x1"] = Math.Floor(cx + len / 2) shape[i]["_y0"] = cy - 4 shape[i]["_y1"] = cy + 4 Else ' rectangle, ellipse or triangle If shape[i]["func"] = "tri" Then ' triangle shape[i]["width"] = shape[i]["x3"] shape[i]["height"] = shape[i]["y2"] EndIf shape[i]["_x0"] = shape[i]["x"] shape[i]["_y0"] = shape[i]["y"] shape[i]["_x1"] = shape[i]["x"] + shape[i]["width"] shape[i]["_y1"] = shape[i]["y"] + shape[i]["height"] EndIf EndSub Sub CalcPinchPos ' param i - shape index ' return mxM, myM - center of pinch _x = shape[i]["x"] _y = shape[i]["y"] width = shape[i]["width"] height = shape[i]["height"] angle = shape[i]["angle"] param = "width=0;height=0;angle=" + angle + ";" param["cx"] = _x + width / 2 param["cy"] = _y + height / 2 Stack.PushValue("local", x) Stack.PushValue("local", y) Stack.PushValue("local", _x) Stack.PushValue("local", _y) param["x"] = param["cx"] param["y"] = param["cy"] - 10 Shapes_CalcRotatePos() mxM = x myM = y _y = Stack.PopValue("local") _x = Stack.PopValue("local") y = Stack.PopValue("local") x = Stack.PopValue("local") EndSub Sub CalcVertexes ' param i - pinch index ' param angle - angle of a shape ' param selectedshape - parent shape index of pinch ' param shape[] - shape data ' return mxM, myM - free vertex ' return mxD, myD - fixed vertex If shape[selectedshape]["func"] = "line" Then If i = 1 Then mxM = shape[selectedshape]["x"] + shape[selectedshape]["x1"] myM = shape[selectedshape]["y"] + shape[selectedshape]["y1"] mxD = shape[selectedshape]["x"] + shape[selectedshape]["x2"] myD = shape[selectedshape]["y"] + shape[selectedshape]["y2"] ElseIf i = 2 Then mxM = shape[selectedshape]["x"] + shape[selectedshape]["x2"] myM = shape[selectedshape]["y"] + shape[selectedshape]["y2"] mxD = shape[selectedshape]["x"] + shape[selectedshape]["x1"] myD = shape[selectedshape]["y"] + shape[selectedshape]["y1"] EndIf Else mxM = shape[selectedshape]["x"] myM = shape[selectedshape]["y"] mxD = mxM myD = myM If i = 1 Or i = 3 Then mxD = mxD + shape[selectedshape]["width"] EndIf If i = 1 Or i = 2 Then myD = myD + shape[selectedshape]["height"] EndIf If i = 2 Or i = 4 Then mxM = mxM + shape[selectedshape]["width"] EndIf If i = 3 Or i = 4 Then myM = myM + shape[selectedshape]["height"] EndIf param = "x=" + mxD + ";y=" + myD + ";width=0;height=0;angle=" + angle param = param + ";cx=" + (mxD + mxM) / 2 + ";cy=" + (myD + myM) / 2 + ";" Shapes_CalcRotatePos() mxD = x myD = y param["x"] = mxM param["y"] = myM Shapes_CalcRotatePos() mxM = x myM = y EndIf EndSub Sub DeleteSelectedShape ' param selectedshape Shapes.Remove(shape[selectedshape]["obj"]) nShapes = nShapes - 1 For _i = selectedshape To nShapes shape[_i] = shape[_i + 1] EndFor shape[nShapes + 1] = "" selectedshape = "" EndSub Sub DetectClickedObject ' mxD, myD - clicked position ' return obj - name of object (menu, shape or pinch) Stack.PushValue("local", i) obj = "" For i = 1 To nPinch If pinch[i]["_x0"] <= mxD And mxD <= pinch[i]["_x1"] And pinch[i]["_y0"] <= myD And myD <= pinch[i]["_y1"] Then obj = "pinch" + i Goto dco_exit EndIf EndFor For i = nShapes To 1 Step -1 param = "x=" + mxD + ";y=" + myD + ";width=0;height=0;" param["cx"] = (shape[i]["_x0"] + shape[i]["_x1"]) / 2 param["cy"] = (shape[i]["_y0"] + shape[i]["_y1"]) / 2 param["angle"] = -shape[i]["angle"] Shapes_CalcRotatePos() If shape[i]["_x0"] <= x And x <= shape[i]["_x1"] And shape[i]["_y0"] <= y And y <= shape[i]["_y1"] Then If shape[i]["func"] = "rect" Or shape[i]["func"] = "line" Then obj = "shape" + i Goto dco_exit ElseIf shape[i]["func"] = "ell" Then x = (x - param["cx"]) / shape[i]["width"] * 2 y = (y - param["cy"]) / shape[i]["height"] * 2 r = Math.SquareRoot(x * x + y * y) If r <= 1 Then obj = "shape" + i Goto dco_exit EndIf ElseIf shape[i]["func"] = "tri" Then x = (x - param["cx"]) / shape[i]["width"] * 2 y = (y - shape[i]["_y1"]) / shape[i]["height"] r = Math.Abs(x) + Math.Abs(y) If r <= 1 And y <= 0 Then obj = "shape" + i Goto dco_exit EndIf EndIf EndIf EndFor For i = 1 To nMenu If menu[i]["func"] <> "" And menu[i]["_x0"] <= mxD And mxD <= menu[i]["_x1"] And menu[i]["_y0"] <= myD And myD <= menu[i]["_y1"] Then obj = "menu" + i Goto dco_exit EndIf EndFor dco_exit: If obj = "" And selectedshape <> "" Then i = selectedshape select = "False" ShapeSelect() EndIf i = Stack.PopValue("local") EndSub Sub DoMenu ' if a menu item clicked do the funciton If Text.StartsWith(obj, "menu") Then param = "down=False;move=False;up=False;" ' wait button pushed Mouse_SetHandler() i = Text.GetSubTextToEnd(obj, 5) obj = "" func = menu[i]["func"] select = "True" ItemSelect() ' shows menu item frame If selecteditem = i And Text.IsSubText("rect|ell|tri|line", func) Then If mode = "repeat" Then mode = "single" Shapes.HideShape(repeat[func]) Else mode = "repeat" Shapes.ShowShape(repeat[func]) EndIf Else mode = "single" EndIf selecteditem = i If Text.IsSubText("open|save|cut|paste|rect|ell|tri|line", func) And selectedshape <> "" Then i = selectedshape select = "False" ShapeSelect() ' removes pinches if a shape selected If func = "cut" Then selectedshape = i EndIf EndIf If func = "open" Then ' open shapes from file ReadShapes() ElseIf func = "save" Then ' save shapes to file WriteShapes() ElseIf func = "cut" Then If selectedshape <> "" Then clipboard = shape[selectedshape] DeleteSelectedShape() EndIf ElseIf func = "copy" Then If selectedshape <> "" Then clipboard = shape[selectedshape] index = "1=x;2=y;3=_x0;4=_x1;5=_y0;6=_y1;" For _i = 1 To 6 clipboard[index[_i]] = clipboard[index[_i]] + 10 EndFor EndIf ElseIf func = "paste" Then If clipboard <> "" Then nShapes = nShapes + 1 shape[nShapes] = clipboard index = "1=x;2=y;3=_x0;4=_x1;5=_y0;6=_y1;" For _i = 1 To 6 clipboard[index[_i]] = clipboard[index[_i]] + 10 EndFor iMin = nShapes iMax = nShapes scale = 1 shX = 0 shY = 0 Shapes_Add() i = nShapes select = "True" ShapeSelect() EndIf ElseIf func = "rect" Or func = "ell" Or func = "tri" Then ' rectangle, ellipse or triangle While "True" WaitToClick() ' to get mxD, myD DetectClickedObject() If Text.StartsWith(obj, "menu") Then Goto dm_exit ' cancel to register shape EndIf obj = "" mxM = mxD myM = myD angle = 0 WaitToReleaseS() ' to get mxU, myU resize = "False" nShapes = nShapes + 1 i = nShapes ' to set shape[nShapes] RegisterShapeData() If w = 0 And h = 0 Then shape[i] = "" nShapes = nShapes - 1 Goto dm_exit ' cansel to register zero sized shape EndIf GraphicsWindow.BrushColor = bcolor GraphicsWindow.PenWidth = pwidth If pwidth > 0 Then GraphicsWindow.PenColor = pcolor EndIf If func = "rect" Then shape[nShapes]["obj"] = Shapes.AddRectangle(w, h) ElseIf func = "ell" Then shape[nShapes]["obj"] = Shapes.AddEllipse(w, h) ElseIf func = "tri" Then shape[nShapes]["obj"] = Shapes.AddTriangle(xt, 0, 0, h, w, h) EndIf Shapes.Move(shape[nShapes]["obj"], xmin, ymin) If mode = "single" Then Goto dm_exit EndIf EndWhile ElseIf func = "line" Then ' line While "True" WaitToClick() ' to get mxD, myD DetectClickedObject() If Text.StartsWith(obj, "menu") Then Goto dm_exit ' cancel to register line EndIf obj = "" mxM = mxD myM = myD WaitToReleaseS() ' to get mxU, myU nShapes = nShapes + 1 i = nShapes ' to set shape[nShapes] RegisterShapeData() If x1 = x2 And y1 = y2 Then shape[i] = "" nShapes = nShapes - 1 Goto dm_exit ' cansel to register zero sized line EndIf GraphicsWindow.BrushColor = bcolor GraphicsWindow.PenWidth = pwidth If pwidth > 0 Then GraphicsWindow.PenColor = pcolor EndIf shape[nShapes]["obj"] = Shapes.AddLine(x1, y1, x2, y2) Shapes.Move(shape[nShapes]["obj"], xmin, ymin) If mode = "single" Then Goto dm_exit EndIf EndWhile ElseIf func = "pw" Then ' pen width If pen = nPen Then pen = 1 Else pen = pen + 1 EndIf pwidth = pw[pen] x = menu[i]["_x0"] y = menu[i]["_y0"] size = menu[i]["_x1"] - x GraphicsWindow.BrushColor = "#EEEEEE" GraphicsWindow.FillRectangle(x, y, size, size) DrawMenuItem() ElseIf func = "pc" Then ' pen color color = pcolor CS_ShowPopup() pcolor = color DrawMenuItem() ElseIf func = "bc" Then ' brush color color = bcolor CS_ShowPopup() bcolor = color DrawMenuItem() ElseIf func = "menubar" And selectedshape <> "" Then i = selectedshape select = "False" ShapeSelect() EndIf If selectedshape <> "" And (func = "pw" Or func = "pc" Or func = "bc") Then i = selectedshape select = "False" ShapeSelect() If func = "pw" Then shape[i]["pw"] = pwidth ElseIf func = "pc" Then shape[i]["pc"] = pcolor ElseIf func = "bc" Then shape[i]["bc"] = color EndIf iMin = i ' to re-size Shapes iMax = nShapes ' to keep z-order of Shapes Shapes_Remove() scale = 1 shX = 0 shY = 0 Shapes_Add() select = "True" ShapeSelect() EndIf dm_exit: i = selecteditem select = "False" ItemSelect() ' removes menu item frame If Text.IsSubText("rect|ell|tri|line", func) Then Shapes.HideShape(repeat[func]) EndIf EndIf EndSub Sub DoObject ' param obj - clicked object While obj <> "" fromMenu = "False" DoMenu() If obj <> "" Then DoShape() EndIf If obj <> "" Then DoPinch() EndIf EndWhile EndSub Sub DoPinch ' if a pinch clicked then rotate or re-size a shape ' param obj - clicked object ' param selectedshape - parent shape index of the pinch If Text.StartsWith(obj, "pinch") Then i = Text.GetSubTextToEnd(obj, 6) obj = "" If i = 5 Then ' rotate a shape i = selectedshape WaitToReleaseR() ' to get angle Shapes.Rotate(shape[i]["obj"], angle) shape[i]["angle"] = Math.Floor(angle) select = "False" ShapeSelect() ' remove pinches select = "True" ShapeSelect() ' show pinches Else ' re-size a shape angle = shape[selectedshape]["angle"] CalcVertexes() ' to get mxM, myM, mxD, myD func = shape[selectedshape]["func"] WaitToReleaseS() ' to get mxU, myU i = selectedshape select = "False" ShapeSelect() ' remove pinches ' selectedshape is broken in ShapeSelect() so use i instead RegisterShapeMetrics() ' re-size shape[i] iMin = i ' to re-size Shapes iMax = nShapes ' to keep z-order of Shapes Shapes_Remove() scale = 1 shX = 0 shY = 0 Shapes_Add() select = "True" ShapeSelect() ' show pinches EndIf EndIf EndSub Sub DoShape ' if a shape clicked then move it If Text.StartsWith(obj, "shape") Then If selectedshape <> "" Then ' if other shape selected i = selectedshape select = "False" ShapeSelect() ' removes pinches EndIf i = Text.GetSubTextToEnd(obj, 6) ' shape index select = "True" ShapeSelect() ' shows pinches Mouse_SetHandler() WaitToReleaseM() ' for moving a shape clicked = "False" obj = "" EndIf EndSub Sub DrawMenu ' return menu[] - array of menu data pwidth = GraphicsWindow.PenWidth cxMenu = 6 cyMenu = 6 sizeMenu = 40 nMenu = 12 GraphicsWindow.BrushColor = "#EEEEEE" GraphicsWindow.FillRectangle(0, 0, GraphicsWindow.Width, 20 + sizeMenu) pw = "1=2;2=4;3=8;4=16;5=0;6=1;" ' pen width pen = 1 ' pen width index nPen = 6 ' number of pen width For i = 1 To nMenu xMenu = cxMenu + Math.Floor((i - 1) / 1) * (sizeMenu + 4) yMenu = cyMenu + Math.Remainder(i - 1, 1) * (sizeMenu + 14) GraphicsWindow.BrushColor = "#EEEEEE" GraphicsWindow.FillRectangle(xMenu, yMenu, sizeMenu, sizeMenu) menu[i]["_x0"] = xMenu menu[i]["_y0"] = yMenu menu[i]["_x1"] = xMenu + sizeMenu menu[i]["_y1"] = yMenu + sizeMenu DrawMenuItem() EndFor nMenu = nMenu + 1 imenubar = nMenu menu[i]["_x0"] = 0 menu[i]["_y0"] = 0 menu[i]["_x1"] = GraphicsWindow.Width menu[i]["_y1"] = 20 + sizeMenu menu[i]["func"] = "menubar" EndSub Sub DrawMenuItem ' param i - item number ' param pwidth - pen width ' param pcolor - pen color ' param bcolor - brush color margin = 4 x = menu[i]["_x0"] y = menu[i]["_y0"] size = menu[i]["_x1"] - x GraphicsWindow.PenColor = "Black" GraphicsWindow.PenWidth = 2 GraphicsWindow.FontBold = "False" GraphicsWindow.FontSize = 8 url = "http://www.nonkit.com/smallbasic.files/" If i = 1 Then menu[i]["func"] = "open" GraphicsWindow.DrawImage(url + "open.png", x, y) itemname[i] = "Open" ElseIf i = 2 Then menu[i]["func"] = "save" GraphicsWindow.DrawImage(url + "save.png", x, y) itemname[i] = "Save" ElseIf i = 3 Then icut = i ' for short cut key menu[i]["func"] = "cut" ' initialize shapes Scissors_Init() nShapes = Array.GetItemCount(shape) ' add shapes scale = 0.11 iMin = 1 iMax = nShapes Shapes_Add() x = x + 14 Shapes_Move() x = x - 14 nShapes = 3 For t = 0 To 360 * 0.3 angle = 30 - 30 * Math.Cos(t * Math.Pi / 180) Shapes_Rotate() EndFor itemname[i] = "Cut" ElseIf i = 4 Then icopy = i ' for short cut key menu[i]["func"] = "copy" GraphicsWindow.DrawImage(url + "copy.png", x, y) itemname[i] = "Copy" ElseIf i = 5 Then ipaste = i ' for short cut key menu[i]["func"] = "paste" GraphicsWindow.DrawImage(url + "paste.png", x, y) itemname[i] = "Paste" ElseIf i = 6 Then menu[i]["func"] = "rect" GraphicsWindow.DrawRectangle(x + margin, y + margin, size - margin * 2, size - margin * 2) itemname[i] = "Rectangle" repeat["rect"] = Shapes.AddImage(url + "repeat.png") Shapes.Move(repeat["rect"], x, y) ' for consecutive shapes addition Shapes.HideShape(repeat["rect"]) ElseIf i = 7 Then menu[i]["func"] = "ell" GraphicsWindow.DrawEllipse(x + margin, y + margin, size - margin * 2, size - margin * 2) itemname[i] = "Ellipse" repeat["ell"] = Shapes.AddImage(url + "repeat.png") Shapes.Move(repeat["ell"], x, y) ' for consecutive shapes addition Shapes.HideShape(repeat["ell"]) ElseIf i = 8 Then menu[i]["func"] = "tri" x1 = x + size / 2 y1 = y + margin x2 = x + margin y2 = y + size - margin x3 = x + size - margin y3 = y + size - margin GraphicsWindow.DrawTriangle(x1, y1, x2, y2, x3, y3) itemname[i] = "Triangle" repeat["tri"] = Shapes.AddImage(url + "repeat.png") Shapes.Move(repeat["tri"], x, y) ' for consecutive shapes addition Shapes.HideShape(repeat["tri"]) ElseIf i = 9 Then menu[i]["func"] = "line" x1 = x + margin y1 = y + margin x2 = x + size - margin y2 = y + size - margin GraphicsWindow.DrawLine(x1, y1, x2, y2) itemname[i] = "Line" repeat["line"] = Shapes.AddImage(url + "repeat.png") Shapes.Move(repeat["line"], x, y) ' for consecutive shapes addition Shapes.HideShape(repeat["line"]) ElseIf i = 10 Then menu[i]["func"] = "pw" GraphicsWindow.PenWidth = pwidth x1 = x + margin y1 = y + size / 2 x2 = x + size - margin y2 = y + size / 2 GraphicsWindow.DrawLine(x1, y1, x2, y2) itemname[i] = "Pen Width" ElseIf i = 11 Then menu[i]["func"] = "pc" margin = 6 GraphicsWindow.PenWidth = 4 GraphicsWindow.PenColor = pcolor GraphicsWindow.DrawRectangle(x + margin, y + margin, size - margin * 2, size - margin * 2) itemname[i] = "Pen Color" ElseIf i = 12 Then menu[i]["func"] = "bc" GraphicsWindow.BrushColor = bcolor GraphicsWindow.FillRectangle(x + margin, y + margin, size - margin * 2, size - margin * 2) GraphicsWindow.PenColor = "Black" GraphicsWindow.PenWidth = 2 GraphicsWindow.DrawRectangle(x + margin, y + margin, size - margin * 2, size - margin * 2) itemname[i] = "Brush Color" EndIf If itemname[i] <> "" And oItem[i] = "" Then GraphicsWindow.BrushColor = "Black" oItem[i] = Shapes.AddText(itemname[i]) Shapes.Move(oItem[i], x + margin, y + size) EndIf GraphicsWindow.FontBold = "True" GraphicsWindow.FontSize = 12 EndSub Sub ItemSelect ' i - menu index ' select - "True" if selected If i <> imenubar Then If select Then GraphicsWindow.PenColor = "Gray" Else GraphicsWindow.PenColor = "#EEEEEE" EndIf GraphicsWindow.PenWidth = 2 x = menu[i]["_x0"] - 1 y = menu[i]["_y0"] - 1 width = menu[i]["_x1"] - x + 1 height = menu[i]["_y1"] - y + 1 GraphicsWindow.DrawRectangle(x, y, width, height) EndIf EndSub Sub NormalizePos ' param mxD, myD - fixed vertex of a shape rotated ' param mxM, myM - opposite vertex of a shape rotated ' param angle - angle of a shape ' return _mxD, _myD - fixed vertex of a shape not rotated ' return _mxM, _myM - opposite vertex of a shape not rotated param = "x=" + mxD + ";y=" + myD + ";width=0;height=0;" param["cx"] = (mxD + mxM) / 2 param["cy"] = (myD + myM) / 2 param["angle"] = -angle Shapes_CalcRotatePos() _mxD = Math.Floor(x) _myD = Math.Floor(y) param["x"] = mxM param["y"] = myM Shapes_CalcRotatePos() _mxM = Math.Floor(x) _myM = Math.Floor(y) EndSub Sub ReadShapes File_Open() ' Parse "shX = ..." ptr = Text.GetIndexOf(buf, "shX = ") If ptr = 0 Then Goto rs_exit EndIf shX = "" ptr = ptr + 6 c = Text.GetSubText(buf, ptr, 1) While Text.GetIndexOf("0123456789", c) > 0 shX = Text.Append(shX, c) ptr = ptr + 1 c = Text.GetSubText(buf, ptr, 1) EndWhile ' Parse "shY = ..." _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shY = ") If _ptr = 0 Then Goto rs_exit EndIf shY = "" ptr = ptr + _ptr + 5 c = Text.GetSubText(buf, ptr, 1) While Text.GetIndexOf("0123456789", c) > 0 shY = Text.Append(shY, c) ptr = ptr + 1 c = Text.GetSubText(buf, ptr, 1) EndWhile ' Parse "shape[i] = ..." While "True" _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shape[") If _ptr = 0 Then Goto rs_exit EndIf ptr = ptr + _ptr + 5 _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "] = " + WQ) If _ptr = 0 Then Goto rs_exit EndIf i = Text.GetSubText(buf, ptr, _ptr - 1) ptr = ptr + _ptr + 4 _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), WQ) If _ptr = 0 Then Goto rs_exit EndIf shape[nShapes + i] = Text.GetSubText(buf, ptr, _ptr - 1) ptr = ptr + _ptr EndWhile rs_exit: iMin = nShapes + 1 nShapes = Array.GetItemCount(shape) iMax = nShapes For i = iMin To iMax shape[i]["x"] = shape[i]["x"] + shX shape[i]["y"] = shape[i]["y"] + shY If shape[i]["func"] = "tri" And (shape[i]["y2"] < shape[i]["y1"]) Then shape[i]["y2"] = shape[i]["y1"] shape[i]["y1"] = shape[i]["y3"] shape[i]["y3"] = shape[i]["y2"] shape[i]["angle"] = shape[i]["angle"] + 180 If shape[i]["angle"] >= 360 Then shape[i]["angle"] = shape[i]["angle"] - 360 EndIf EndIf CalcDetectBorder() If shape[i]["pc"] <> "" Then color = shape[i]["pc"] CS_AddColorToPalette() EndIf If shape[i]["bc"] <> "" Then color = shape[i]["bc"] CS_AddColorToPalette() EndIf EndFor shX = 0 shY = 0 scale = 1 Shapes_Add() EndSub Sub RegisterShapeData ' param i - index of shapes ' param func - "rect", "ell", "tri" or "line" ' return shape[i] - shape data shape[i]["func"] = func RegisterShapeStyle() RegisterShapeMetrics() EndSub Sub RegisterShapeMetrics ' param i - index of shapes ' param func - "rect", "ell", "tri" or "line" ' param mxD, myD - fixed vertex ' param mxU, myU - opposite vertex ' return shape[i] - shape data ' return xmin, ymin, w, h - shape position and size ' return xt - top position for triangle ' return x1, y1, x2, y2 - line position If func = "line" Then ' line xmin = Math.Min(mxD, mxU) ymin = Math.Min(myD, myU) xmax = Math.Max(mxD, mxU) ymax = Math.Max(myD, myU) x1 = mxD - xmin y1 = myD - ymin x2 = mxU - xmin y2 = myU - ymin shape[i]["x1"] = x1 shape[i]["y1"] = y1 shape[i]["x2"] = x2 shape[i]["y2"] = y2 Else ' rectangle, ellipse or triangle mxM = mxU myM = myU angle = shape[i]["angle"] NormalizePos() xmin = Math.Min(_mxD, _mxM) ymin = Math.Min(_myD, _myM) xmax = Math.Max(_mxD, _mxM) ymax = Math.Max(_myD, _myM) w = xmax - xmin h = ymax - ymin shape[i]["width"] = w shape[i]["height"] = h EndIf shape[i]["x"] = xmin shape[i]["y"] = ymin If func = "tri" Then ' triangle xt = Math.Floor((xmax - xmin) / 2) ' x top shape[i]["x1"] = xt shape[i]["y1"] = 0 shape[i]["x2"] = 0 shape[i]["y2"] = h shape[i]["x3"] = w shape[i]["y3"] = h EndIf CalcDetectBorder() EndSub Sub RegisterShapeStyle ' param i - index of shapes ' param pwidth - pen width ' param pcolor - pen color ' param bcolor - brush color ' return shape[i] - shape data shape[i]["pw"] = pwidth If pwidth > 0 Then shape[i]["pc"] = pcolor Else shape[i]["pc"] = "" EndIf If func <> "line" Then ' rectangle, ellipse or triangle shape[i]["bc"] = bcolor EndIf EndSub Sub ShapeSelect ' Show or remove pinches for a selected shape ' param i - shape index ' param select - "True" if selected ' return selectedshape - selected shape index If select Then Stack.PushValue("local", x) Stack.PushValue("local", y) GraphicsWindow.PenColor = "Black" GraphicsWindow.PenWidth = 1 sizePinch = 10 selectedshape = i shX = shape[i]["x"] shY = shape[i]["y"] GraphicsWindow.BrushColor = "Lime" If shape[i]["func"] = "line" Then nPinch = 2 For _i = 1 To nPinch pinch[_i]["obj"] = Shapes.AddEllipse(sizePinch, sizePinch) x = shX + shape[i]["x" + _i] - sizePinch / 2 y = shY + shape[i]["y" + _i] - sizePinch / 2 Shapes.Move(pinch[_i]["obj"], x, y) pinch[_i]["_x0"] = x pinch[_i]["_y0"] = y pinch[_i]["_x1"] = x + sizePinch pinch[_i]["_y1"] = y + sizePinch EndFor Else pinch[5]["obj"] = Shapes.AddEllipse(sizePinch, sizePinch) shWidth = shape[i]["width"] shHeight = shape[i]["height"] param["cx"] = shX + shWidth / 2 param["cy"] = shY + shHeight / 2 param["angle"] = shape[i]["angle"] param["x"] = shX + shWidth / 2 - sizePinch / 2 param["y"] = shY - 30 - sizePinch / 2 param["width"] = sizePinch param["height"] = sizePinch Shapes_CalcRotatePos() Shapes.Move(pinch[5]["obj"], x, y) pinch[5]["_x0"] = x pinch[5]["_y0"] = y pinch[5]["_x1"] = x + sizePinch pinch[5]["_y1"] = y + sizePinch nPinch = 5 xPinch = "1=0;2=" + shWidth + ";3=0;4=" + shWidth + ";" yPinch = "1=0;2=0;3=" + shHeight + ";4=" + shHeight + ";" GraphicsWindow.BrushColor = "#639AE7" For _i = 1 To 4 pinch[_i]["obj"] = Shapes.AddEllipse(sizePinch, sizePinch) param["x"] = shX + xPinch[_i] - sizePinch / 2 param["y"] = shY + yPinch[_i] - sizePinch / 2 Shapes_CalcRotatePos() Shapes.Move(pinch[_i]["obj"], x, y) pinch[_i]["_x0"] = x pinch[_i]["_y0"] = y pinch[_i]["_x1"] = x + sizePinch pinch[_i]["_y1"] = y + sizePinch EndFor EndIf y = Stack.PopValue("local") x = Stack.PopValue("local") Else selectedshape = "" For _i = 1 To nPinch Shapes.Remove(pinch[_i]["obj"]) EndFor nPinch = 0 EndIf EndSub Sub WaitToClick ' return mxD, myD - clicked point param = "down=True;move=False;up=False;" ' wait to click Mouse_SetHandler() While clicked = "False" Program.Delay(100) EndWhile EndSub Sub WaitToReleaseM ' for moving a shape ' param i - shape index ' param mxD, myD - fixed vertex of a shape ' return mxU, myU - opposite vertex of a shape GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "White" param = "down=False;move=True;" ' for moving a shape Mouse_SetHandler() func = shape[i]["func"] _x = shape[i]["x"] _y = shape[i]["y"] shAngle = shape[i]["angle"] mxM = mxD myM = myD moved = "True" While released = "False" If moved Then param = "move=False;" ' while moving a shape Mouse_SetHandler() _x = shape[i]["x"] + mxM - mxD _y = shape[i]["y"] + myM - myD If oFrame[func] = "" Then If func = "rect" Then oFrame[func] = Shapes.AddRectangle(shape[i]["width"], shape[i]["height"]) ElseIf func = "ell" Then oFrame[func] = Shapes.AddEllipse(shape[i]["width"], shape[i]["height"]) ElseIf func = "tri" Then _x1 = shape[i]["x1"] _y1 = shape[i]["y1"] _x2 = shape[i]["x2"] _y2 = shape[i]["y2"] _x3 = shape[i]["x3"] _y3 = shape[i]["y3"] oFrame[func] = Shapes.AddTriangle(_x1, _y1, _x2, _y2, _x3, _y3) ElseIf func = "line" Then _x1 = shape[i]["x1"] _y1 = shape[i]["y1"] _x2 = shape[i]["x2"] _y2 = shape[i]["y2"] oFrame[func] = Shapes.AddLine(_x1, _y1, _x2, _y2) Shapes.SetOpacity(oFrame[func], 50) EndIf EndIf If func = "rect" Or func = "ell" Or func = "tri" Then Shapes.SetOpacity(oFrame[func], 0) Shapes.Move(oFrame[func], _x, _y) Shapes.Rotate(oFrame[func], shAngle) Shapes.SetOpacity(oFrame[func], 50) ElseIf func = "line" Then Shapes.Move(oFrame[func], _x, _y) EndIf param = "move=True;" ' for next moving a shape Mouse_SetHandler() Else Program.Delay(100) EndIf EndWhile param = "move=False;up=False;" ' mouse released Mouse_SetHandler() MoveShape() If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) oFrame[func] = "" EndIf EndSub Sub MoveShape ' param i - shape index ' param _x, _y - new position of the shape dx = _x - shape[i]["x"] dy = _y - shape[i]["y"] shape[i]["x"] = _x shape[i]["y"] = _y shape[i]["_x0"] = shape[i]["_x0"] + dx shape[i]["_x1"] = shape[i]["_x1"] + dx shape[i]["_y0"] = shape[i]["_y0"] + dy shape[i]["_y1"] = shape[i]["_y1"] + dy Shapes.Move(shape[i]["obj"], _x, _y) If shape[i]["func"] = "line" Then _iMax = 2 Else _iMax = 5 EndIf For _i = 1 To _iMax pinch[_i]["_x0"] = pinch[_i]["_x0"] + dx pinch[_i]["_x1"] = pinch[_i]["_x1"] + dx pinch[_i]["_y0"] = pinch[_i]["_y0"] + dy pinch[_i]["_y1"] = pinch[_i]["_y1"] + dy Shapes.Move(pinch[_i]["obj"], pinch[_i]["_x0"], pinch[_i]["_y0"]) EndFor EndSub Sub WaitToReleaseR ' for rotating a shape ' param i - shape index ' return angle - angle for rotation GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "White" param = "down=False;move=True;up=True;" ' for rotating a shape / wait to release Mouse_SetHandler() CalcPinchPos() ' into mxM, myM cx = param["cx"] cy = param["cy"] func = shape[i]["func"] If func = "tri" Then x1 = shape[i]["x1"] y1 = shape[i]["y1"] x2 = shape[i]["x2"] y2 = shape[i]["y2"] x3 = shape[i]["x3"] y3 = shape[i]["y3"] EndIf moved = "True" If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) EndIf If func = "rect" Then oFrame[func] = Shapes.AddRectangle(width, height) ElseIf func = "ell" Then oFrame[func] = Shapes.AddEllipse(width, height) ElseIf func = "tri" Then oFrame[func] = Shapes.AddTriangle(x1, y1, x2, y2, x3, y3) EndIf Shapes.SetOpacity(oFrame[func], 0) Shapes.Move(oFrame[func], _x, _y) While released = "False" If moved Then param = "move=False;" ' while sizing a shape Mouse_SetHandler() x = mxM - cx y = myM - cy If x <> 0 Or y <> 0 Then Math_CartesianToPolar() angle = Math.Floor(a + 90) If angle >= 360 Then angle = angle - 360 EndIf EndIf Shapes.Rotate(oFrame[func], angle) Shapes.SetOpacity(oFrame[func], 50) param = "move=True;" ' for next sizing a shape Mouse_SetHandler() Else Program.Delay(100) EndIf EndWhile param = "move=False;up=False;" ' mouse released Mouse_SetHandler() If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) oFrame[func] = "" EndIf EndSub Sub WaitToReleaseS ' for sizing a shape ' param func - "rect", "ell", "tri" or "line" because shape index may not decided ' param mxD, myD - fixed vertex of a shape ' param mxM, myM - opposite vertex of a shape ' param angle - angle of a shape ' return mxU, myU - opposite vertex of a shape GraphicsWindow.PenWidth = 1 GraphicsWindow.PenColor = "Black" GraphicsWindow.BrushColor = "White" param = "down=False;move=True;up=True;" ' for sizing a shape / wait to release Mouse_SetHandler() moved = "True" While released = "False" If moved Then param = "move=False;" ' while sizing a shape Mouse_SetHandler() If func = "rect" Or func = "ell" Or func = "tri" Then If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) EndIf NormalizePos() xmin = Math.Min(_mxD, _mxM) ymin = Math.Min(_myD, _myM) xmax = Math.Max(_mxD, _mxM) ymax = Math.Max(_myD, _myM) If func = "rect" Then oFrame[func] = Shapes.AddRectangle(xmax - xmin, ymax - ymin) ElseIf func = "ell" Then oFrame[func] = Shapes.AddEllipse(xmax - xmin, ymax - ymin) ElseIf func = "tri" Then oFrame[func] = Shapes.AddTriangle((xmax - xmin) / 2, 0, 0, ymax - ymin, xmax - xmin, ymax - ymin) EndIf Shapes.SetOpacity(oFrame[func], 0) Shapes.Move(oFrame[func], xmin, ymin) Shapes.Rotate(oFrame[func], angle) Shapes.SetOpacity(oFrame[func], 50) ElseIf func = "line" Then If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) EndIf oFrame[func] = Shapes.AddLine(mxD, myD, mxM, myM) Shapes.SetOpacity(oFrame[func], 50) EndIf param = "move=True;" ' for next sizing a shape Mouse_SetHandler() Else Program.Delay(100) EndIf EndWhile param = "move=False;up=False;" ' mouse released Mouse_SetHandler() If oFrame[func] <> "" Then Shapes.Remove(oFrame[func]) oFrame[func] = "" EndIf EndSub Sub WriteShapes Stack.PushValue("local", i) buf = "' " + Clock.Date + " " + Clock.Time + " Generated" buf = buf + " by " + title + CRLF buf = buf + "'" + CRLF buf = buf + "' initialize shapes" + CRLF buf = buf + "Shapes_Init()" + CRLF buf = buf + "' add shapes" + CRLF buf = buf + "scale = 1" + CRLF buf = buf + "Shapes_Add()" + CRLF buf = buf + "angle = 0" + CRLF + CRLF buf = buf + "Sub Shapes_Init" + CRLF buf = buf + " ' Shapes | Initialize shapes data" + CRLF buf = buf + " ' return shX, shY - current position of shapes" + CRLF buf = buf + " ' return shape - array of shapes" + CRLF If nShapes > 0 Then xmin = shape[1]["x"] ymin = shape[1]["y"] xmax = shape[1]["x"] ymax = shape[1]["y"] EndIf For i = 2 To nShapes If shape[i]["x"] < xmin Then xmin = shape[i]["x"] EndIf If shape[i]["y"] < ymin Then ymin = shape[i]["y"] EndIf If xmax < shape[i]["x"] Then xmax = shape[i]["x"] EndIf If ymax < shape[i]["y"] Then ymax = shape[i]["y"] EndIf EndFor buf = buf + " shX = " + xmin + " ' x offset" + CRLF buf = buf + " shY = " + ymin + " ' y offset" + CRLF buf = buf + " shape = " + WQ + WQ + CRLF For i = 1 To nShapes If shape[i]["func"] = "rect" Or shape[i]["func"] = "ell" Then buf = buf + " shape[" + i + "] = " + WQ + "func=" + shape[i]["func"] + ";" buf = buf + "x=" + (shape[i]["x"] - xmin) + ";" buf = buf + "y=" + (shape[i]["y"] - ymin) + ";" buf = buf + "width=" + shape[i]["width"] + ";" buf = buf + "height=" + shape[i]["height"] + ";" If shape[i]["angle"] <> 0 And shape[i]["angle"] <> "" Then buf = buf + "angle=" + shape[i]["angle"] + ";" EndIf buf = buf + "bc=" + shape[i]["bc"] + ";" ElseIf shape[i]["func"] = "tri" Then buf = buf + " shape[" + i + "] = " + WQ + "func=tri;" buf = buf + "x=" + (shape[i]["x"] - xmin) + ";" buf = buf + "y=" + (shape[i]["y"] - ymin) + ";" buf = buf + "x1=" + shape[i]["x1"] + ";" buf = buf + "y1=" + shape[i]["y1"] + ";" buf = buf + "x2=" + shape[i]["x2"] + ";" buf = buf + "y2=" + shape[i]["y2"] + ";" buf = buf + "x3=" + shape[i]["x3"] + ";" buf = buf + "y3=" + shape[i]["y3"] + ";" If shape[i]["angle"] <> 0 And shape[i]["angle"] <> "" Then buf = buf + "angle=" + shape[i]["angle"] + ";" EndIf buf = buf + "bc=" + shape[i]["bc"] + ";" ElseIf shape[i]["func"] = "line" Then buf = buf + " shape[" + i + "] = " + WQ + "func=line;" buf = buf + "x=" + (shape[i]["x"] - xmin) + ";" buf = buf + "y=" + (shape[i]["y"] - ymin) + ";" buf = buf + "x1=" + shape[i]["x1"] + ";" buf = buf + "y1=" + shape[i]["y1"] + ";" buf = buf + "x2=" + shape[i]["x2"] + ";" buf = buf + "y2=" + shape[i]["y2"] + ";" EndIf If shape[i]["pw"] > 0 Then buf = buf + "pc=" + shape[i]["pc"] + ";" EndIf buf = buf + "pw=" + shape[i]["pw"] + ";" + WQ + CRLF EndFor buf = buf + "EndSub" + CRLF buf = buf + CRLF buf = buf + "Sub Shapes_Add" + CRLF buf = buf + " ' Shapes | Add shapes as shapes data" + CRLF buf = buf + " ' param shape - array of shapes" + CRLF buf = buf + " ' param scale - to zoom" + CRLF buf = buf + " ' return nShapes - number of shapes" + CRLF buf = buf + " ' return shAngle - current angle of shapes" + CRLF buf = buf + " Stack.PushValue(" + WQ + "local" + WQ + ", i)" + CRLF buf = buf + " nShapes = Array.GetItemCount(shape)" + CRLF buf = buf + " s = scale" + CRLF buf = buf + " For i = 1 To nShapes" + CRLF buf = buf + " GraphicsWindow.PenWidth = shape[i][" + WQ + "pw" + WQ + "] * s" + CRLF buf = buf + " If shape[i][" + WQ + "pw" + WQ + "] > 0 Then" + CRLF buf = buf + " GraphicsWindow.PenColor = shape[i][" + WQ + "pc" + WQ + "]" + CRLF buf = buf + " EndIf" + CRLF buf = buf + " If shape[i][" + WQ + "func" + WQ + "] = " + WQ + "rect" + WQ + " Then" + CRLF buf = buf + " GraphicsWindow.BrushColor = shape[i][" + WQ + "bc" + WQ + "]" + CRLF buf = buf + " shape[i][" + WQ + "obj" + WQ + "] = Shapes.AddRectangle(shape[i][" + WQ + "width" + WQ + "]* s, shape[i][" + WQ + "height" + WQ + "] * s)" + CRLF buf = buf + " ElseIf shape[i][" + WQ + "func" + WQ + "] = " + WQ + "ell" + WQ + " Then" + CRLF buf = buf + " GraphicsWindow.BrushColor = shape[i][" + WQ + "bc" + WQ + "]" + CRLF buf = buf + " shape[i][" + WQ + "obj" + WQ + "] = Shapes.AddEllipse(shape[i][" + WQ + "width" + WQ + "]* s, shape[i][" + WQ + "height" + WQ + "] * s)" + CRLF buf = buf + " ElseIf shape[i][" + WQ + "func" + WQ + "] = " + WQ + "tri" + WQ + " Then" + CRLF buf = buf + " GraphicsWindow.BrushColor = shape[i][" + WQ + "bc" + WQ + "]" + CRLF buf = buf + " shape[i][" + WQ + "obj" + WQ + "] = Shapes.AddTriangle(shape[i][" + WQ + "x1" + WQ + "] * s, shape[i][" + WQ + "y1" + WQ + "] * s, shape[i][" + WQ + "x2" + WQ + "] * s, shape[i][" + WQ + "y2" + WQ + "] * s, shape[i][" + WQ + "x3" + WQ + "] * s, shape[i][" + WQ + "y3" + WQ + "] * s)" + CRLF buf = buf + " ElseIf shape[i][" + WQ + "func" + WQ + "] = " + WQ + "line" + WQ + " Then" + CRLF buf = buf + " shape[i][" + WQ + "obj" + WQ + "] = Shapes.AddLine(shape[i][" + WQ + "x1" + WQ + "] * s, shape[i][" + WQ + "y1" + WQ + "] * s, shape[i][" + WQ + "x2" + WQ + "] * s, shape[i][" + WQ + "y2" + WQ + "] * s)" + CRLF buf = buf + " EndIf" + CRLF buf = buf + " Shapes.Move(shape[i][" + WQ + "obj" + WQ + "], shX + shape[i][" + WQ + "x" + WQ + "] * s, shY + shape[i][" + WQ + "y" + WQ + "] * s)" + CRLF buf = buf + " If Text.IsSubText(" + WQ + "rect|ell|tri" + WQ + ", shape[i][" + WQ + "func" + WQ + "]) And shape[i][" + WQ + "angle" + WQ + "] <> 0 Then" + CRLF buf = buf + " Shapes.Rotate(shape[i][" + WQ + "obj" + WQ + "], shape[i][" + WQ + "angle" + WQ + "])" + CRLF buf = buf + " EndIf" + CRLF buf = buf + " shape[i][" + WQ + "rx" + WQ + "] = shape[i][" + WQ + "x" + WQ + "]" + CRLF buf = buf + " shape[i][" + WQ + "ry" + WQ + "] = shape[i][" + WQ + "y" + WQ + "]" + CRLF buf = buf + " EndFor" + CRLF buf = buf + " shAngle = 0" + CRLF buf = buf + " i = Stack.PopValue(" + WQ + "local" + WQ + ")" + CRLF buf = buf + "EndSub" + CRLF ' Import GTV460-0 and insert here if you need move and rotation in output program. File_Save() i = Stack.PopValue("local") EndSub Sub Color_ColorToRGB ' Color | Convert Color to RGB ' param sColor - "#rrggbb" ' return iR, iG, iB - [0, 255] sR = Text.GetSubText(sColor, 2, 2) sG = Text.GetSubText(sColor, 4, 2) sB = Text.GetSubText(sColor, 6, 2) sHex = sR Math_Hex2Dec() iR = iDec sHex = sG Math_Hex2Dec() iG = iDec sHex = sB Math_Hex2Dec() iB = iDec EndSub Sub Color_HSLtoRGB ' Color | Convert HSL to RGB ' param rHue - [0, 360) or UNDEFINED ' param rLightness - [0, 1] ' param rSaturation - [0, 1] ' return iR, iG, iB - RGB color ' return sColor - "#rrggbb" If rLightness <= 0.5 Then rN2 = rLightness * (1 + rSaturation) Else rN2 = rLightness + rSaturation - rLightness * rSaturation EndIf rN1 = 2 * rLightness - rN2 If rSaturation = 0 Then iR = Math.Round(rLightness * 255) iG = Math.Round(rLightness * 255) iB = Math.Round(rLightness * 255) Else rH = rHue + 120 Color_Value() iR = iValue rH = rHue Color_Value() iG = iValue rH = rHue - 120 Color_Value() iB = iValue EndIf sColor = GraphicsWindow.GetColorFromRGB(iR, iG, iB) EndSub Sub Color_RGBtoHSL ' Color | Convert RGB to HSL ' param sColor - "#rrggbb" ' return rHue - [0, 360) or UNDEFINED ' return rLightness - (0, 1) ' return rSaturation - (0, 1) Color_ColorToRGB() ' rR = iR / 255 ' occurs Math.Max() bug rR = Math.Round(iR / 255 * 10000) / 10000 ' rG = iG / 255 ' occurs Math.Max() bug rG = Math.Round(iG / 255 * 10000) / 10000 ' rB = iB / 255 ' occurs Math.Max() bug rB = Math.Round(iB / 255 * 10000) / 10000 rMax = Math.Max(rR, rG) rMax = Math.Max(rMax, rB) rMin = Math.Min(rR, rG) rMin = Math.Min(rMin, rB) rLightness = (rMax + rMin) / 2 If rMax = rMin Then ' rR = rG = rB rSaturation = 0 rHue = UNDEFINED Else If rLightness <= 0.5 Then rSaturation = (rMax - rMin) / (rMax + rMin) Else rSaturation = (rMax - rMin) / (2 - rMax - rMin) EndIf rRC = (rMax - rR) / (rMax - rMin) rGC = (rMax - rG) / (rMax - rMin) rBC = (rMax - rB) / (rMax - rMin) If rR = rMax Then ' between Yellow and Magenta rHue = rBC - rGC ElseIf rG = rMax Then ' between Cyan and Yellow rHue = 2 + rRC - rBC ElseIf rB = rMax Then ' between Magenta and Cyan rHue = 4 + rGC - rRC Else TextWindow.WriteLine("Error:") TextWindow.WriteLine("rMax=" + rMax) TextWindow.WriteLine("rR=" + rR + ",sR=" + sR) TextWindow.WriteLine("rG=" + rG + ",sG=" + sG) TextWindow.WriteLine("rB=" + rB + ",sB=" + sB) EndIf rHue = rHue * 60 If rHue < 0 Then rHue = rHue + 360 EndIf EndIf EndSub Sub Color_Value ' Color | Function value ' param rN1, rN2 ' param rH - [-120, 480) ' return iValue - 0..255 If rH >= 360 Then rH = rH - 360 EndIF If rH < 0 Then rH = rH + 360 EndIF If rH < 60 Then rV = rN1 + (rN2 - rN1) * rH / 60 ElseIf rH < 180 Then rV = rN2 ElseIf rH < 240 Then rV = rN1 + (rN2 - rN1) * (240 - rH) / 60 Else rV = rN1 EndIf iValue = Math.Round(rV * 255) EndSub Sub CS_AddColorToPalette ' Color Selector | Add color to palette ' param color - color to set ' param maxPalette ' param nPalette ' param palette ' param tPalette - target palette Stack.PushValue("local", i) For i = 1 To nPalette If color = palette[i]["color"] Then Goto csactp_not_new_color EndIf EndFor palette[tPalette]["color"] = color If nPalette < maxPalette Then nPalette = nPalette + 1 EndIf tPalette = tPalette + 1 If maxPalette < tPalette Then tPalette = 1 EndIf csactp_not_new_color: i = Stack.PopValue("local") EndSub Sub CS_AdjustSlider ' Color Selector | Adjust slider ' param iSlider - moved slider Stack.PushValue("local", iSlider) If iSlider = iHue Or iSlider = iLightness Or iSlider = iSaturation Then If iSlider = iHue Then Slider_GetLevel() rHue = level ElseIf iSlider = iLightness Then Slider_GetLevel() rLightness = level / 100 Else Slider_GetLevel() rSaturation = level / 100 EndIf Color_HSLtoRGB() iSlider = iRed level = iR Slider_SetLevel() iSlider = iGreen level = iG Slider_SetLevel() iSlider = iBlue level = iB Slider_SetLevel() Else CS_GetColorFromSlider() sColor = GraphicsWindow.GetColorFromRGB(red, green, blue) Color_RGBtoHSL() If rHue = UNDEFINED Then rHue = 0 EndIf iSlider = iHue level = Math.Floor(rHue) Slider_SetLevel() iSlider = iSaturation level = Math.Floor(rSaturation * 100) Slider_SetLevel() iSlider = iLightness level = Math.Floor(rLightness * 100) Slider_SetLevel() EndIf iSlider = Stack.PopValue("local") EndSub Sub CS_DoObject ' Color Selector | Do object ' param - obj While obj <> "" CS_DoSlider() If obj <> "" Then CS_DoPalette() EndIf EndWhile EndSub Sub CS_DoPalette ' Color Selector | Do palette ' param obj - clicked object If Text.StartsWith(obj, "palette") Then iPalette = Text.GetSubTextToEnd(obj, 8) color = palette[iPalette]["color"] CS_SetColorToSlider() ' set color to slider CS_ShowNewColor() ' show new color name CS_DrawColorRect() ' draw new color rectangle obj = "" param = "down=True;move=False;up=False;" ' wait to click Mouse_SetHandler() EndIf EndSub Sub CS_DoSlider ' Color Selector | Do slider ' param obj - clicked object ' param iSlider - index of slider If Text.StartsWith(obj, "slider") Then Slider_WaitToRelease() obj = "" param = "down=True;move=False;up=False;" ' wait to click Mouse_SetHandler() EndIf EndSub Sub CS_DrawColorRect ' Color Selector | Draw color rectangle ' param color - color of rectangle ' param x, y, width, height - position and size of rectangle ' return oRect - rectangle object GraphicsWindow.BrushColor = color GraphicsWindow.PenColor = BORDERCOLOR If oRect <> "" Then Shapes.Remove(oRect) EndIf oRect = Shapes.AddRectangle(width, height) Shapes.Move(oRect, x, y) EndSub Sub CS_DrawPalette ' Color Selector | Draw palette ' param palette[] - color palette ' param nPalette - number of color in palette ' param x, y, width, height - position and size of rectangle ' return oPalette[] - palette object array Stack.PushValue("local", i) GraphicsWindow.PenColor = BORDERCOLOR For i = 1 To nPalette GraphicsWindow.BrushColor = palette[i]["color"] palette[i]["oCell"] = Shapes.AddRectangle(width, height) dx = Math.Remainder((i - 1), 8) * (width + 4) dy = Math.Floor((i - 1) / 8) * (height + 4) Shapes.Move(palette[i]["oCell"], x + dx, y + dy) palette[i]["x"] = x + dx palette[i]["y"] = y + dy palette[i]["width"] = width palette[i]["height"] = height EndFor i = Stack.PopValue("local") EndSub Sub CS_GetColorFromSlider ' Color Selector | get color from slider ' return color Stack.PushValue("local", iSlider) iSlider = iRed ' slider index Slider_GetLevel() red = level iSlider = iGreen ' slider index Slider_GetLevel() green = level iSlider = iBlue ' slider index Slider_GetLevel() blue = level color = GraphicsWindow.GetColorFromRGB(red, green, blue) iSlider = Stack.PopValue("local") EndSub Sub CS_Init ' Color Selector | Initialize sliders width = 256 min = 0 max = 255 left = 190 ' add red slider top = TOPY caption = "R" Slider_Add() iRed = iSlider ' index of slider ' add green slider top = top + DELTAY caption = "G" Slider_Add() iGreen = iSlider ' index of slider ' add blue slider top = top + DELTAY caption = "B" Slider_Add() iBlue = iSlider ' index of slider ' add hue slider width = 360 top = top + DELTAY max = 360 caption = "H" Slider_Add() iHue = iSlider ' index of slider ' add saturation slider width = 100 top = top + DELTAY max = 100 caption = "S" Slider_Add() iSaturation = iSlider ' index of slider ' add lightness slider width = 100 top = top + DELTAY max = 100 caption = "L" Slider_Add() iLightness = iSlider ' index of slider ' draw color rectangle CS_GetColorFromSlider() CS_ShowNewColor() x = LEFTX y = TOPY + DELTAY * 4 width = 100 height = 100 CS_DrawColorRect() ' add text box GraphicsWindow.BrushColor = CAPTIONCOLOR top = y + height + 4 oNewColor = Shapes.AddText("") Shapes.Move(oNewColor, LEFTX, top) EndSub Sub CS_DumpSlider ' Color Selector | Dump slider for debug For i = 1 To numSlider TextWindow.WriteLine("slider" + i) TextWindow.WriteLine(slider[i]) EndFor EndSub Sub CS_InitPalette ' Color Selector | Initialize palette ' This subroutine should be called before CS_ShowPopup(). pcolor = GraphicsWindow.PenColor bcolor = GraphicsWindow.BrushColor maxPalette = 16 ' max cell number of palette nPalette = 2 ' number of palette in use tPalette = 3 ' index of update target cell palette[1]["color"] = pcolor palette[2]["color"] = bcolor EndSub Sub CS_RemovePalette ' Color Selector | Remove palette ' param nPalette - number of color in palette ' return oPalette[] - palette object array Stack.PushValue("local", i) For i = 1 To nPalette oPalette = "Palette" + i Shapes.Remove(palette[i]["oCell"]) EndFor i = Stack.PopValue("local") EndSub Sub CS_RemoveSliders ' Color Selector | Remove sliders For iSlider = 1 To numSlider Slider_Remove() EndFor numSlider = 0 EndSub Sub CS_SearchClickedObject ' Color Selector | Check slider clicked ' param mxD, myD - clicked point ' return obj - clicked slider or palette ' return iSlider - index if obj is slider ' return iPalette - index if obj is palette Stack.PushValue("local", i) For iSlider = 1 To numSlider obj = "slider" + iSlider x2 = slider[iSlider]["x2"] y2 = slider[iSlider]["y2"] x3 = slider[iSlider]["x3"] y3 = slider[iSlider]["y3"] If x2 <= mxD And mxD <= x3 And y2 <= myD And myD <= y3 Then Goto scco_obj_found EndIf EndFor For iPalette = 1 To nPalette obj = "palette" + iPalette x2 = palette[iPalette]["x"] y2 = palette[iPalette]["y"] x3 = palette[iPalette]["x"] + palette[iPalette]["width"] y3 = palette[iPalette]["y"] + palette[iPalette]["height"] If x2 <= mxD And mxD <= x3 And y2 <= myD And myD <= y3 Then Goto scco_obj_found EndIf EndFor obj = "" scco_obj_found: i = Stack.PopValue("local") EndSub Sub CS_SetColorToSlider ' Color Selector | Set color to slider ' param color Stack.PushValue("local", iSlider) sColor = color Color_ColorToRGB() iSlider = iRed level = iR Slider_SetLevel() iSlider = iGreen level = iG Slider_SetLevel() iSlider = iBlue level = iB Slider_SetLevel() CS_AdjustSlider() iSlider = Stack.PopValue("local") EndSub Sub CS_ShowNewColor ' Color Selector | Show new color ' param oColor ' param color Shapes.SetText(oNewColor, color) EndSub Sub CS_ShowPopup ' Color Selector | Show popup ' param color - current color ' return color - new color ' define constant Stack.PushValue("local", cont) colorInit = color ' initial color TOPY = 80 ' top y LEFTX = 36 ' left x BORDERCOLOR = "#666666" BOXCOLOR = "LightGray" CAPTIONCOLOR = "White" DELTAY = 36 ' delta y SLITCOLOR = "#555555" TEXTCOLOR = "Black" UNDEFINED = "N/A" POPUPCOLOR = "Black" GraphicsWindow.PenWidth = 2 GraphicsWindow.PenColor = POPUPCOLOR GraphicsWindow.BrushColor = POPUPCOLOR oPopup = Shapes.AddRectangle(570, 310) Shapes.SetOpacity(oPopup, 64) Shapes.Move(oPopup, LEFTX - 10, TOPY - 10) oOK = Controls.AddButton("OK", LEFTX + 440, TOPY + 260) oCancel = Controls.AddButton("Cancel", LEFTX + 480, TOPY + 260) Controls.ButtonClicked = CS_OnButtonClicked CS_Init() Stack.PushValue("local", y) y = TOPY color = colorInit CS_DrawColorRect() ' original color oRectCurrent = oRect oRect = "" ' keep current color GraphicsWindow.SetPixel(0, 0, colorInit) color = GraphicsWindow.GetPixel(0, 0) GraphicsWindow.SetPixel(0, 0, "LightGray") GraphicsWindow.BrushColor = CAPTIONCOLOR oColor = Shapes.AddText(colorInit) Shapes.Move(oColor, x, y + height + 2) If color <> colorInit Then oColor2 = Shapes.AddText(color) Shapes.Move(oColor2, x, y + height + 14) EndIf y = Stack.PopValue("local") CS_SetColorToSlider() CS_DrawColorRect() ' draw new color rectangle CS_ShowNewColor() ' show new color name Stack.PushValue("local", x) Stack.PushValue("local", y) Stack.PushValue("local", width) Stack.PushValue("local", height) x = x + width + 30 y = TOPY + height * 2 + 24 width = 30 height = 30 CS_DrawPalette() height = Stack.PopValue("local") width = Stack.PopValue("local") y = Stack.PopValue("local") x = Stack.PopValue("local") cont = "True" ' continue param = "down=True;move=False;up=False;" ' wait click Mouse_SetHandler() While cont If clicked Then CS_SearchClickedObject() CS_DoObject() clicked = "False" Else Program.Delay(100) EndIf EndWhile If cancel Then color = colorInit Else CS_AddColorToPalette() EndIf CS_RemovePalette() CS_RemoveSliders() Shapes.Remove(oColor) Shapes.Remove(oColor2) Shapes.Remove(oNewColor) Shapes.Remove(oRectCurrent) Shapes.Remove(oRect) Controls.Remove(oOK) Controls.Remove(oCancel) Shapes.Remove(oPopup) cont = Stack.PopValue("local") EndSub Sub CS_OnButtonClicked ' Color Selector | Event handler on button clicked cont = "False" If Controls.LastClickedButton = oCancel Then cancel = "True" Else cancel = "False" EndIf EndSub Sub File_Open ' File | Show output program to save Stack.PushValue("local", cont) TOPY = 80 ' top y LEFTX = 36 ' left x CAPTIONCOLOR = "White" POPUPCOLOR = "Black" TEXTCOLOR = "Black" GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = POPUPCOLOR oPopup = Shapes.AddRectangle(570, 310) Shapes.SetOpacity(oPopup, 64) Shapes.Move(oPopup, LEFTX - 10, TOPY - 10) GraphicsWindow.BrushColor = CAPTIONCOLOR oCaption = Shapes.AddText("Filename") Shapes.Move(oCaption, LEFTX, TOPY + 2) GraphicsWindow.BrushColor = TEXTCOLOR oFilename = Controls.AddTextBox(LEFTX + 80, TOPY) Controls.SetSize(oFilename, 300, 24) oText = Controls.AddMultilineTextBox(LEFTX, TOPY + 30) '<------------- Controls.SetSize(oText, 550, 210) oOK = Controls.AddButton("OK", LEFTX + 500, TOPY + 260) ' Controls. = File_OnButtonClicked '<------------- Controls.ButtonClicked = File_OnTextTyped '<------------- ' The following line could be harmful and has been automatically commented. ' SLIST= File.GetFiles(Program.Directory) '<------------- ShapesbLST="" '<------------- For i=1 To Array.GetItemCount(SLIST) '<------------- If Text.IsSubText(SLIST[i],"Shape") And Text.IsSubText(SLIST[i],".sb") Then '<------------- midp= Text.GetIndexOf(SLIST[i],"Shape") '<------------- ShapesbLST=ShapesbLST+text.GetSubTextToEnd(SLIST[i],midP)+Text.GetCharacter(13)+Text.GetCharacter(10) '<------------- endif '<------------- EndFor '<------------- Controls.SetTextBoxText(oText,ShapesbLST) '<------------- subname = "Shapes_Init" fo_retry: typed = "False" While typed="False" '<------------- Program.Delay(200) EndWhile filename = program.Directory+"\"+Controls.GetTextBoxText(oFilename) '<------------- SB_GetSub() typed = "False" Controls.Remove(oFilename) Controls.Remove(oText) Controls.Remove(oOK) Controls.Remove(oPopup) cont = Stack.PopValue("local") EndSub Sub File_OnTextTyped ' File | Textbox event handler typed = "True" EndSub Sub File_Save ' File | Show output program to save ' param buf - program buffer ' define constant Stack.PushValue("local", cont) TOPY = 80 ' top y LEFTX = 36 ' left x POPUPCOLOR = "Black" TEXTCOLOR = "Black" CAPTIONCOLOR = "White" GraphicsWindow.PenWidth = 0 GraphicsWindow.BrushColor = POPUPCOLOR oPopup = Shapes.AddRectangle(570, 310) Shapes.SetOpacity(oPopup, 64) Shapes.Move(oPopup, LEFTX - 10, TOPY - 10) GraphicsWindow.BrushColor = TEXTCOLOR oText = Controls.AddTextBox(LEFTX, TOPY) Controls.SetSize(oText, 550, 240) Controls.SetTextBoxText(oText, buf) oOK = Controls.AddButton("OK", LEFTX + 500, TOPY + 260) GraphicsWindow.BrushColor = CAPTIONCOLOR oMsg = Shapes.AddText("Click OK , then it's saved as Shape20121017_123456.sb in your Program.directory ") Shapes.Move(oMsg, LEFTX, TOPY + 260) cont = "True" ' continue Controls.ButtonClicked = File_OnButtonClicked While cont Program.Delay(500) EndWhile Controls.Remove(oText) Controls.Remove(oMsg) Controls.Remove(oOK) Controls.Remove(oPopup) cont = Stack.PopValue("local") Fdate=text.Append(text.Append(Clock.Year,Clock.Month),Clock.day)+"_"+text.Append(text.Append(Clock.hour,Clock.Minute),Clock.Second) '<------------- PGDS=program.Directory+"\Shape_"+fdate+".sb" '<------------- ' The following line could be harmful and has been automatically commented. ' File.WriteContents(PGDS,buf) '<------------- EndSub Sub File_OnButtonClicked ' File | Button event handler cont = "False" EndSub Sub KB_FlushFIFO ' Keyborad | Flush keyboard buffer (FIFO) For out = out + 1 To in fifok[out] = "" fifos[out] = "" fifoc[out] = "" EndFor EndSub Sub KB_InKey ' Keyboard | In key ' return c - input key c = "" If in > out Then out = out + 1 c = fifok[out] _shift = fifos[out] _ctrl = fifoc[out] fifok[out] = "" fifos[out] = "" fifoc[out] = "" If Text.GetLength(c) > 1 Then If Array.ContainsIndex(keys, c) Then c = keys[_shift + c] Else c = "<" + c + ">" EndIf ElseIf _shift = "" Then c = Text.ConvertToLowerCase(c) EndIf c = Text.Append(_ctrl, c) EndIf EndSub Sub KB_Init ' Keyboard | Initialization for Shapes (use only ^x, ^c, ^v, del and arrow keys) shift = "" ctrl = "" in = 0 out = 0 keys = "Delete=DEL;Left=LEFT;Right=RIGHT;Up=UP;Down=DOWN;" arrow_dx = "LEFT=-1;RIGHT=1;UP=0;DOWN=0;" arrow_dy = "LEFT=0;RIGHT=0;UP=-1;DOWN=1;" GraphicsWindow.KeyDown = KB_OnKeyDown GraphicsWindow.KeyUp = KB_OnKeyUp EndSub Sub KB_OnKeyDown ' Keyboard | Key down event handler key = GraphicsWindow.LastKey If key = "LeftShift" Or key = "RightShift" Then shift = "+" ElseIf key = "LeftCtrl" Or key = "RightCtrl" Then ctrl = "^" Else in = in + 1 fifok[in] = key fifos[in] = shift fifoc[in] = ctrl EndIf EndSub Sub KB_OnKeyUp ' Keyboard | Key up event handler key = GraphicsWindow.LastKey If key = "LeftShift" Or key = "RightShift" Then shift = "" ElseIf key = "LeftCtrl" Or key = "RightCtrl" Then ctrl = "" EndIf EndSub Sub Math_CartesianToPolar ' Math | convert cartesian coodinate to polar coordinate ' param x, y - cartesian coordinate ' return r, a - polar coordinate r = Math.SquareRoot(x * x + y * y) If x = 0 And y > 0 Then a = 90 ' [degree] ElseIf x = 0 And y < 0 Then a = -90 Else a = Math.ArcTan(y / x) * 180 / Math.Pi EndIf If x < 0 Then a = a + 180 ElseIf x > 0 And y < 0 Then a = a + 360 EndIf EndSub Sub Math_Hex2Dec ' Math | Convert hexadecimal to decimal ' param sHex ' return iDec iDec = 0 iLen = Text.GetLength(sHex) For iPtr = 1 To iLen iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1 EndFor EndSub Sub Mouse_Init ' Mouse | Initialize for common event handler clicked = "False" moved = "False" released = "False" If debug Then Timer.Interval = 200 Timer.Tick = Mouse_OnTick EndIf EndSub Sub Mouse_SetHandler ' Mouse | Set or reset common event handler ' param["down"] - "True" if set, "False" if reset ' param["move"] - "True" if set, "False" if reset ' param["up"] - - "True" if set, "False" if reset ' return clicked - "False" if set MouseDown ' return moved - "False" if set MouseMove ' return released - "False" if set MouseUp ' return dmu - which handlers are set for debug If param["up"] Then released = "False" GraphicsWindow.MouseUp = Mouse_OnUp handler["up"] = "U" ElseIf param["up"] = "False" Then GraphicsWindow.MouseUp = Mouse_DoNothing handler["up"] = "" EndIf If param["down"] Then clicked = "False" GraphicsWindow.MouseDown = Mouse_OnDown handler["down"] = "D" ElseIf param["down"] = "False" Then GraphicsWindow.MouseDown = Mouse_DoNothing handler["down"] = "" EndIf If param["move"] Then moved = "False" GraphicsWindow.MouseMove = Mouse_OnMove handler["move"] = "M" ElseIf param["move"] = "False" Then GraphicsWindow.MouseMove = Mouse_DoNothing handler["move"] = "" EndIf dmu = handler["down"] + handler["move"] + handler["up"] If debug Then smrc = " set " EndIf EndSub Sub Mouse_OnDown ' Mouse | Common event handler on mouse down ' return mxD, myD - position on mouse down mxD = GraphicsWindow.MouseX myD = GraphicsWindow.MouseY clicked = "True" released = "False" If debug Then smrc = " clicked " + mxD + "," + myD EndIf EndSub Sub Mouse_DoNothing ' Mouse | Common event handler to do nothing EndSub Sub Mouse_OnMove ' Mouse | Common event handler on mouse move ' return mxM, myM - position on mouse move mxM = GraphicsWindow.MouseX myM = GraphicsWindow.MouseY moved = "True" If debug Then smrc = " moved " + mxM + "," + myM EndIf EndSub Sub Mouse_OnTick ' Mouse | debug routine If clicked Then cmr = "C" Else cmr = "" EndIf If moved Then cmr = cmr + "M" EndIf If released Then cmr = cmr + "R" EndIf GraphicsWindow.Title = title + smrc + " " + dmu + " " + cmr EndSub Sub Mouse_OnUp ' Mouse | Common event handler on mouse up ' return mxU, myU - position on mouse up mxU = GraphicsWindow.MouseX myU = GraphicsWindow.MouseY released = "True" If debug Then smrc = " released " + mxU + "," + myU EndIf EndSub Sub SB_GetSub ' Small Basic | Get subroutine from Small Basic source file ' param filename - file name ' param subname - subroutine name ' return buf - subroutine buffer len = Text.GetLength(subname) ' The following line could be harmful and has been automatically commented. ' The following line could be harmful and has been automatically commented. ' buf = File.ReadContents(filename) ptr = 1 notFound = "True" While notFound _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "Sub") If _ptr = 0 Then buf = "" Goto sbgs_exit EndIf ptrSub = ptr + _ptr - 1 ptr = ptrSub + 3 While Text.GetSubText(buf, ptr, 1) = " " ptr = ptr + 1 EndWhile If Text.GetSubText(buf, ptr, len) = subname Then notFound = "False" EndIf EndWhile _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "EndSub") If _ptr = 0 Then buf = "" Goto sbgs_exit EndIf ptrEndSub = ptr + _ptr - 1 ptr = ptrEndSub + 6 len = ptr - ptrSub buf = Text.GetSubText(buf, ptrSub, len) sbgs_exit: Controls.SetTextBoxText(oText, buf) EndSub Sub Scissors_Init ' Scissors | Initialize shapes data for menu icon ' return shX, shY - current position of shapes ' return shape - array of shapes shX = 230 ' x offset shY = 30 ' y offset shape = "" shape[1] = "func=tri;x=45;y=0;x1=22;y1=0;x2=0;y2=213;x3=44;y3=213;bc=#6E6E6E;pw=0;" shape[2] = "func=rect;x=45;y=212;width=15;height=47;bc=#6E6E6E;pw=0;" shape[3] = "func=ell;x=0;y=235;width=66;height=104;bc=#EEEEEE;pc=#0C95BB;pw=16;" shape[4] = "func=tri;x=45;y=0;x1=22;y1=0;x2=0;y2=213;x3=44;y3=213;bc=#939393;pw=0;" shape[5] = "func=rect;x=75;y=212;width=14;height=49;bc=#919191;pw=0;" shape[6] = "func=ell;x=61;y=163;width=13;height=15;bc=#6E6E6E;pw=0;" shape[7] = "func=ell;x=70;y=236;width=64;height=104;bc=#EEEEEE;pc=#0C95BB;pw=16;" EndSub Sub Shapes_Add ' Shapes | add shapes as shapes data ' param shape - array of shapes ' param iMin, iMax - shape indices to add ' param scale - 1 if same scale ' return shWidth, shHeight - total size of shapes ' return shAngle - current angle of shapes Stack.PushValue("local", i) Shapes_CalcWidthAndHeight() s = scale For i = iMin To iMax GraphicsWindow.PenWidth = shape[i]["pw"] * s If shape[i]["pw"] > 0 Then GraphicsWindow.PenColor = shape[i]["pc"] EndIf If shape[i]["func"] = "rect" Then GraphicsWindow.BrushColor = shape[i]["bc"] shape[i]["obj"] = Shapes.AddRectangle(shape[i]["width"]* s, shape[i]["height"] * s) ElseIf shape[i]["func"] = "ell" Then GraphicsWindow.BrushColor = shape[i]["bc"] shape[i]["obj"] = Shapes.AddEllipse(shape[i]["width"]* s, shape[i]["height"] * s) ElseIf shape[i]["func"] = "tri" Then GraphicsWindow.BrushColor = shape[i]["bc"] shape[i]["obj"] = Shapes.AddTriangle(shape[i]["x1"] * s, shape[i]["y1"] * s, shape[i]["x2"] * s, shape[i]["y2"] * s, shape[i]["x3"] * s, shape[i]["y3"] * s) ElseIf shape[i]["func"] = "line" Then shape[i]["obj"] = Shapes.AddLine(shape[i]["x1"] * s, shape[i]["y1"] * s, shape[i]["x2"] * s, shape[i]["y2"] * s) EndIf Shapes.Move(shape[i]["obj"], shX + shape[i]["x"] * s, shY + shape[i]["y"] * s) If Text.IsSubText("rect|ell|tri", shape[i]["func"]) And shape[i]["angle"] <> 0 Then Shapes.Rotate(shape[i]["obj"], shape[i]["angle"]) EndIf shape[i]["rx"] = shape[i]["x"] shape[i]["ry"] = shape[i]["y"] EndFor shAngle = 0 i = Stack.PopValue("local") EndSub Sub Shapes_CalcWidthAndHeight ' Shapes | Calculate total width and height of shapes ' param iMin, iMax - shape indices to add ' return nShapes - number of shapes ' return shWidth, shHeight - total size of shapes For i = iMin To iMax If shape[i]["func"] = "tri" Or shape[i]["func"] = "line" Then xmin = shape[i]["x1"] xmax = shape[i]["x1"] ymin = shape[i]["y1"] ymax = shape[i]["y1"] If shape[i]["x2"] < xmin Then xmin = shape[i]["x2"] EndIf If xmax < shape[i]["x2"] Then xmax = shape[i]["x2"] EndIf If shape[i]["y2"] < ymin Then ymin = shape[i]["y2"] EndIf If ymax < shape[i]["y2"] Then ymax = shape[i]["y2"] EndIf If shape[i]["func"] = "tri" Then If shape[i]["x3"] < xmin Then xmin = shape[i]["x3"] EndIf If xmax < shape[i]["x3"] Then xmax = shape[i]["x3"] EndIf If shape[i]["y3"] < ymin Then ymin = shape[i]["y3"] EndIf If ymax < shape[i]["y3"] Then ymax = shape[i]["y3"] EndIf EndIf shape[i]["width"] = xmax - xmin shape[i]["height"] = ymax - ymin EndIf If i = 1 Then shWidth = shape[i]["x"] + shape[i]["width"] shHeight = shape[i]["y"] + shape[i]["height"] Else If shWidth < shape[i]["x"] + shape[i]["width"] Then shWidth = shape[i]["x"] + shape[i]["width"] EndIf If shHeight < shape[i]["y"] + shape[i]["height"] Then shHeight = shape[i]["y"] + shape[i]["height"] EndIf EndIf EndFor EndSub Sub Shapes_CalcRotatePos ' Shapes | Calculate position for rotated shape ' param["x"], param["y"] - position of a shape ' param["width"], param["height"] - size of a shape ' param ["cx"], param["cy"] - center of rotation ' param ["angle"] - rotate angle ' return x, y - rotated position of a shape _cx = param["x"] + param["width"] / 2 _cy = param["y"] + param["height"] / 2 x = _cx - param["cx"] y = _cy - param["cy"] Math_CartesianToPolar() a = a + param["angle"] x = r * Math.Cos(a * Math.Pi / 180) y = r * Math.Sin(a * Math.Pi / 180) _cx = x + param["cx"] _cy = y + param["cy"] x = _cx - param["width"] / 2 y = _cy - param["height"] / 2 EndSub Sub Shapes_Move ' Shapes | Move shapes ' param shape - array of shapes ' param scale ' param x, y - position to move ' return shX, shY - new position of shapes Stack.PushValue("local", i) shX = x shY = y For i = 1 To nShapes _x = shape[i]["x"] _y = shape[i]["y"] Shapes.Move(shape[i]["obj"], shX + _x * s, shY + _y * s) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Remove ' Shapes | Remove shapes ' param iMin, iMax - shapes indices to remove ' param shape - array of shapes Stack.PushValue("local", i) For i = iMin To iMax Shapes.Remove(shape[i]["obj"]) EndFor i = Stack.PopValue("local") EndSub Sub Shapes_Rotate ' Shapes | Rotate shapes ' param shape - array of shapes ' param scale - to zoom ' param angle - to rotate Stack.PushValue("local", i) Stack.PushValue("local", x) Stack.PushValue("local", y) s = scale param["angle"] = angle param["cx"] = shWidth / 2 param["cy"] = shHeight / 2 For i = 1 To nShapes param["x"] = shape[i]["x"] param["y"] = shape[i]["y"] param["width"] = shape[i]["width"] param["height"] = shape[i]["height"] Shapes_CalcRotatePos() Shapes.Move(shape[i]["obj"], shX + x * s, shY + y * s) Shapes.Rotate(shape[i]["obj"], angle) EndFor y = Stack.PopValue("local") x = Stack.PopValue("local") i = Stack.PopValue("local") EndSub Sub Slider_Add ' Slider | Add slider as shapes and property ' param width ' param caption ' param min, max ' param left, top ' return slider[] - property of slider ' return iSlider - added slider index numSlider = numSlider + 1 iSlider = numSlider ' add shapes for slider GraphicsWindow.BrushColor = CAPTIONCOLOR len = Text.GetLength(caption) slider[iSlider]["oCaption"] = Shapes.AddText(caption) Shapes.Move(slider[iSlider]["oCaption"], left - (len * 5 + 10), top + 1) level = Math.Floor((min + max) / 2) slider[iSlider]["level"] = level ' property slider[iSlider]["min"] = min slider[iSlider]["max"] = max GraphicsWindow.PenColor = BORDERCOLOR mag = (level - min) / (max - min) GraphicsWindow.BrushColor = SLITCOLOR slider[iSlider]["oSlit"] = Shapes.AddRectangle(width, 10) GraphicsWindow.PenColor = BORDERCOLOR GraphicsWindow.BrushColor = BOXCOLOR slider[iSlider]["oBox"] = Shapes.AddRectangle(10, 18) GraphicsWindow.BrushColor = CAPTIONCOLOR slider[iSlider]["oLevel"] = Shapes.AddText(level) slider[iSlider]["x0"] = left slider[iSlider]["x1"] = left + width slider[iSlider]["y0"] = top Shapes.Move(slider[iSlider]["oLevel"], left + width + 5, top) ' move and zoom shapes for slider Shapes.Move(slider[iSlider]["oSlit"], left, top + 4) Slider_SetLevel() EndSub Sub Slider_CallBack ' Slider | Call back ' param iSlider - changed slider CS_AdjustSlider() CS_GetColorFromSlider() CS_ShowNewColor() ' show new color name CS_DrawColorRect() ' draw new color rectangle EndSub Sub Slider_GetLevel ' Slider | Get latest level of slider ' param iSlider ' return level level = slider[iSlider]["level"] EndSub Sub Slider_GetMouseLevel ' Slider | Get mouse level of slider ' param iSlider ' return level x0 = slider[iSlider]["x0"] x1 = slider[iSlider]["x1"] max = slider[iSlider]["max"] min = slider[iSlider]["min"] level = min + Math.Floor((max - min) * (mxM - x0) / (x1 - x0)) EndSub Sub Slider_WaitToRelease ' Slider | Get released point for slider moving ' param iSlider param = "down=False;move=True;up=True;" ' for slider moving / wait to release Mouse_SetHandler() While released = "False" If moved Then param = "move=False;" ' while slider moving Mouse_SetHandler() x0_ = slider[iSlider]["x0"] x1_ = slider[iSlider]["x1"] If mxM < x0_ Then mxM = x0_ EndIf If x1_ < mxM Then mxM = x1_ EndIf Slider_GetMouseLevel() ' get mouse level of slider Slider_SetLevel() ' set slider level and move slider box Slider_CallBack() param = "move=True;" ' for next slider moving Mouse_SetHandler() Else Program.Delay(100) EndIf EndWhile param = "move=False;up=False;" ' mouse released Mouse_SetHandler() EndSub Sub Slider_Remove ' Slider | Remove a slider ' param iSlider Shapes.Remove(slider[iSlider]["oCaption"]) Shapes.Remove(slider[iSlider]["oSlit"]) Shapes.Remove(slider[iSlider]["oBox"]) Shapes.Remove(slider[iSlider]["oLevel"]) EndSub Sub Slider_SetLevel ' Slider | Set slider level and move slider box ' param iSlider ' param level Stack.PushValue("local", width) x0 = slider[iSlider]["x0"] x1 = slider[iSlider]["x1"] y0 = slider[iSlider]["y0"] width = x1 - x0 slider[iSlider]["level"] = level Shapes.SetText(slider[iSlider]["oLevel"], level) ' move bar min = slider[iSlider]["min"] max = slider[iSlider]["max"] mag = (level - min) / (max - min) ' move box Shapes.Move(slider[iSlider]["oBox"], x0 + Math.Floor(width * mag) - 5, y0) slider[iSlider]["x2"] = x0 + Math.Floor(width * mag) - 5 slider[iSlider]["x3"] = x0 + Math.Floor(width * mag) - 5 + 10 slider[iSlider]["y2"] = y0 slider[iSlider]["y3"] = y0 + 18 width = Stack.PopValue("local") EndSub End>QXK334.sb< Start>QXL006.sb< 'Program KOU-KO-GEN N O T E I R I- Eddy Abts 19-4-2020 Info=0 '0 is no info - 1 is results - 2 all info - info is always written to infofile SetupInfo() If info>0 Then textScreen() EndIf InitVar() GraphicsScreen() DrawGrid() Drawpalette() '====== MAIN PROGRAM ======= 'START DRAWING LINE For Ax=Bx+.1 To End Step mystep 'begin of point Ax is Bx + .1 To avoid division by 0 DistanceAtoC() DrawLine() dif=hp-5 If difsign="pos" and dif<0 Then LDCall.Function3("infoFunc","1","======= SOLUTION ==========","Red") LDCall.Function3("infoFunc","1","50-Ax= "+Ax+ " Cy= "+Cy+" Hp = "+Hp,"Red") LDCall.Function3("infoFunc","1","51-DIF = "+dif,"Red") mytxtshape=shapes.addtext("A "+Ax) 'draw solution on screen Shapes.move(mytxtshape,Ax*100+100,560) mytxtshape=shapes.addtext("C "+Cyrnd) Shapes.move(mytxtshape,110,(6-Cy)*100) LDCall.Function3("infoFunc","1","53-===========================================","Red") difsign="neg" if info>0 then Program.Delay(2000) endif ElseIf difsign="neg" and dif>0 Then LDCall.Function3("infoFunc","1","======= SOLUTION ==========","Red") LDCall.Function3("infoFunc","1","60-Ax= "+Ax+ " Cy= "+Cyrnd+" Hp = "+Hp,"Red") LDCall.Function3("infoFunc","1","61-DIF = "+dif,"Red") mytxtshape=shapes.addtext("A "+Ax) 'draw solution on screen Shapes.move(mytxtshape,Ax*100+80,560) mytxtshape=shapes.addtext("C "+Cyrnd) Shapes.move(mytxtshape,110,(6-Cy)*100-20) LDCall.Function3("infoFunc","1","66-===========================================","Red") difsign="pos" if info>0 then Program.Delay(2000) endif EndIf Endfor 'END MAIN PROGRAM '============================================================================================= sub Coordinates Gx=args[1] Gy=args[2] LDCall.Function2("infoFunc","2","96- Gx= "+ Gx +" ; Gy= "+ Gy ) Gx=(Gx+1)*100 Gy=(6-Gy)*100 LDCall.Function2("infoFunc","2","99- Gx= "+ Gx +" ; Gy= "+ Gy ) endsub '=================== S U B R O U T I N E - DistanceAtoC==================== sub DistanceAtoC m=(By-Ay)/(Bx-Ax) 'Line equation : y=mx+p ===> m=slope p=Ay-(m * Ax) 'p=y-mp and Ay=0 p=-m * Ax Cx=0 'Point C(x,y) is intersection with y-axes Cy= p ' all digits CyRnd=Math.Round(Cy*1000)/1000 Hp= math.SquareRoot(Ax*Ax + Cy*Cy) ' all digits Hp100=Math.Round(Hp*100)/100 'Hypothenusa rounded at 2 digits behind comma Hp1000=Math.Round(Hp*1000)/1000 'Hypothenusa rounded at 2 digits behind comma LDCall.Function2("infoFunc","2","96-Hypothenusa : "+Hp1000) 'Calculate and draws Endpoint of the ladder Lx=(Ly-p)/m Ly=(Ladder*Cy)/Math.SquareRoot(Cy*Cy+Ax*Ax) 'The endpoint of the ladder ldcall.function4("Coordinates",Lx,Ly,Gx,Gy) LDCall.Function2("infoFunc","2","120-Gx= "+Gx+" ; Gy= "+Gy ) GraphicsWindow.brushcolor = "red" graphicswindow.fillellipse(Gx-1,Gy-1,2,2) GraphicsWindow.brushcolor = "Green" LDCall.Function2("infoFunc","2","89-Lx = "+Lx+" Ly = "+Ly) Endsub '=================== S U B R O U T I N E - DrawLine ==================== Sub DrawLine If Hp100=5 Then GraphicsWindow.Pencolor="brown" GraphicsWindow.PenWidth = 4 Else GraphicsWindow.Pencolor="green" GraphicsWindow.PenWidth = 1 EndIf If myline <> "" And remove Then Shapes.remove(myline) EndIf Gx=(Gx+1)*100 Gy=(6-Gy)*100 ldcall.function4("Coordinates",Ax,Ay,Gx,Gy) If HP100<>5 Then myline=shapes.addLine(Gx,Gy,0,600-(Cy*(Ax+1)/Ax)*100) Else myline=shapes.addLine(Gx,Gy,100,600-(Cy*100)) EndIf If Hp100=5 Then remove = "False" Else remove = "True" EndIf LDCall.Function2("infoFunc","2","42-===========================================") LDCall.Function2("infoFunc","2","43-Ax= "+Ax+ " Cy= "+Cy+" Hp = "+Hp) LDCall.Function2("infoFunc","2","45-DIF = "+dif) EndSub '=================== S U B R O U T I N E - DrawGrid ==================== Sub DrawGrid GraphicsWindow.PenColor = "Green" GraphicsWindow.BrushColor = "Green" GraphicsWindow.DrawLine(0, 0, 0, 700) For _x = 0 To 700 Step 100 GraphicsWindow.DrawLine(_x, 0, _x, 700) If _x=0 Then GraphicsWindow.DrawText(_x +4, 580, (_x/100)-1) Else GraphicsWindow.DrawText(_x -10, 580, (_x/100)-1) EndIf EndFor For _y=700 To 0 Step -100 GraphicsWindow.DrawLine(0, _y, 700, _y) GraphicsWindow.DrawText(104, _y + 4, 6-_y/100) EndFor EndSub '=================== S U B R O U T I N E - infoFunction ==================== Sub InfoFunc if info = 0 and args[1] = 0 then TextWindow.ForegroundColor=(args[3]) TextWindow.WriteLine(args[2]) endif if info = 1 and args[1] <= 1 then TextWindow.ForegroundColor=(args[3]) TextWindow.WriteLine(args[2]) TextWindow.ForegroundColor=("White") EndIf If info = 2 and args[1] <= 2 then TextWindow.ForegroundColor=(args[3]) TextWindow.WriteLine(args[2]) TextWindow.ForegroundColor=("White") endif ' The following line could be harmful and has been automatically commented. ' File.AppendContents(infoFile,args[2]) EndSub '=================== S U B R O U T I N E - T E X T S C R E E N ==================== Sub TextScreen TextWindow.top=0 TextWindow.left=900 TextWindow.ForegroundColor = "white" EndSub '=================== S U B R O U T I N E - G R A P H I C S S C R E E N ==================== Sub GraphicsScreen GraphicsWindow.top=0 GraphicsWindow.Left=0 GraphicsWindow.Width=700 GraphicsWindow.Height=600 GraphicsWindow.Title = "K O U - KO - G E N N O T E I R I" GraphicsWindow.CanResize="False" EndSub '=================== S U B R O U T I N E - I N I T V A R ==================== Sub InitVar Ay=0 'A is the point of the ladder on the x-axes Bx=1.20 'B is the point on top of the palette By=1.50 Cx=0 'C is the point of the ladder on the x-axes Cy=4.8 Ladder=5.00 args = "" mystep = 0.001 End=6 'End=6 for testing specific interval - End=scale min=999 max=0 flag="down" difsign="pos" EndSub '=================== S U B R O U T I N E - D R A W P A L E T T E ==================== Sub Drawpalette GraphicsWindow.penwidth=1 GraphicsWindow.BrushColor="#FF5A00" GraphicsWindow.FillRectangle(100,600-By*100,Bx*100,By*100) Endsub '=================== S U B R O U T I N E - S E T U P I N F O ==================== Sub SetupInfo ' The following line could be harmful and has been automatically commented. ' InfoFile=Program.Directory + "\InfoFile.txt" ' The following line could be harmful and has been automatically commented. ' File.DeleteFile(InfoFile) ' The following line could be harmful and has been automatically commented. ' File.AppendContents(InfoFile,"InfoFile : "+Clock.date+" = "+Clock.time) ' The following line could be harmful and has been automatically commented. ' File.AppendContents(InfoFile,"=================================") EndSub End>QXL006.sb< Start>QXM265.sb< ' SmallBasic Version 1.2 ' Program: BinarySearch ' Changelog: ' Author: Pappa Lapub ' Website: https://social.msdn.microsoft.com/Forums/en-US/97557d8d-42b3-429f-9d09-b53e4793d80c/binary-search-in-small-basic ' ImportURL: http://smallbasic.com/program/? ' Extension: ' Comment: http://forgetcode.com/CSharp/1036-Binary-search-programming ' http://www.dreamincode.net/forums/topic/365436-Perform-binary-search-in-C%23/ ' Variables: ' ToDo: ' ================================================================================ array[1] = 5658845 array[2] = 8080152 array[3] = 1005231 array[4] = 4520125 array[5] = 4562555 array[6] = 6545231 array[7] = 7895122 array[8] = 5552012 array[9] = 3852085 array[10] = 8777541 array[11] = 50505520 array[12] = 7576651 array[13] = 8451277 array[14] = 7825877 array[15] = 7881200 array[16] = 1302850 array[17] = 1250255 array[18] = 4581002 nNums = Array.GetItemCount(array) SortArray() For i = 1 To nNums searchValue = array[i] 'searchValue = Math.GetRandomNumber(50505520) ' Falsification array[Max] FindIndex() If bFound Then TextWindow.WriteLine(searchValue + " Valid Account") Else TextWindow.WriteLine(searchValue + " not a valid account number") EndIf TextWindow.WriteLine("") EndFor ' ////////// SUBs \\\\\\\\\\ Sub FindIndex low = 0 high = nNums bFound = "" While low <= high mid = Math.Round((low + high) / 2) If searchValue < array[mid] Then high = mid - 1 ElseIf searchValue > array[mid] Then low = mid + 1 ElseIf searchValue = array[mid] Then 'TextWindow.WriteLine(searchValue +" Search successful at "+ mid) bFound = "True" low = high + 1 ' ExitWhile EndIf EndWhile 'If bFound <> "True" Then ' TextWindow.WriteLine(searchValue + " Search unsuccessful") 'EndIf EndSub Sub SortArray For n = 1 To nNums - 1 For m = n + 1 To nNums If array[n] > array[m] Then temp = array[n] array[n] = array[m] array[m] = temp EndIf EndFor EndFor 'TextWindow.WriteLine(array) ''1=1005231;2=1250255;3=1302850;4=3852085;5=4520125;6=4562555;7=4581002;8=5552012;9=5658845; ''10=6545231;11=7576651;12=7825877;13=7881200;14=7895122;15=8080152;16=8451277;17=8777541;18 ''=50505520; EndSub End>QXM265.sb< Start>QXP527.sb< 'simple slideshow demo 'load demo text as import PBX736 ' The following line could be harmful and has been automatically commented. ' ffl=File.ReadContents ("e:\txtneur.txt")'<----ref.here ur text ff= LDText.Split (ffl Text.GetCharacter (13)+Text.GetCharacter (10)) gw=1444 GraphicsWindow.Width=gw GraphicsWindow.Height=999 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.BackgroundColor="teal GraphicsWindow.BrushColor="white GraphicsWindow.KeyDown=kkk GraphicsWindow.Title ="SlideShow" Sub kkk kk="false EndSub While "true GraphicsWindow.Clear () For x=1 To Array.GetItemCount (ff) If Text.StartsWith (ff[x] "/h1") Then 'main header tt=text.GetSubTextToEnd (ff[x] 5) GraphicsWindow.FontName="Calibri GraphicsWindow.FontSize=60 GraphicsWindow.FontBold="true Program.Delay (142) w=LDText.GetWidth (tt) GraphicsWindow.BrushColor="black GraphicsWindow.DrawText (gw/2-w/2+5 105 tt) GraphicsWindow.BrushColor="white GraphicsWindow.DrawText (gw/2-w/2 100 tt) hh=255 elseIf Text.StartsWith (ff[x] "/h2") Then 'header 2 tt=text.GetSubTextToEnd (ff[x] 5) GraphicsWindow.FontName="Calibri GraphicsWindow.FontSize=45 GraphicsWindow.FontBold="true Program.Delay (142) w=LDText.GetWidth (tt) h= LDText.GetHeight (tt) GraphicsWindow.DrawText (gw/2-w/2 hh tt) GraphicsWindow.PenWidth =2 GraphicsWindow.PenColor="lime GraphicsWindow.DrawLine (0 hh+50 gw hh+50) hh=hh+h+100 elseIf Text.StartsWith (ff[x] "/p") Then 'pause GraphicsWindow.DrawText(30 GraphicsWindow.Height-66 " > > >") kk="true while kk Program.Delay (22) endwhile GraphicsWindow.Clear () hh=40 elseIf Text.StartsWith (ff[x] "/r") Then 'repeat slshw GraphicsWindow.DrawText(30 GraphicsWindow.Height-66 " < < <@") kk="true while kk Program.Delay (22) endwhile GraphicsWindow.Clear () hh=40 elseIf Text.StartsWith (ff[x] "//") Then 'emptyline hh=hh+50 Else GraphicsWindow.FontSize=30 GraphicsWindow.FontBold="false GraphicsWindow.DrawBoundText (40 hh gw-80 ff[x]) rr=math.Round (LDText.GetWidth (ff[x])/(gw-80))+1 Program.Delay (133) hh=hh+ LDText.GetHeight (ff[x])*rr Program.Delay (255) endif EndFor EndWhile End>QXP527.sb< Start>QXQ421.sb< args=0 wInitVars() Timer.Interval = 1000 ' one tick per second Timer.Tick = OnTimerTick GraphicsWindow.MouseDown = OnMouseDown TextWindow.WriteLine("Started - ok.") TextWindow.Left=800 GraphicsWindow.Left=10 GraphicsWindow.Top=50 Sub OnTimerTick If wMovingNow = 0 Then If wnewgame = 1 Then wside = -wside wFEN = wStartFEN wSetFEN() 'set starting position TextWindow.WriteLine("NEW GAME") wCleaCurs() wDrawBoard() Else If wtakeback = 1 Then wDoTakeBack() 'take back move TextWindow.WriteLine("TAKEBACK") wCleaCurs() wDrawBoard() Else 'Automatic gameplay mode If (wauto = 1 Or wturn <> wside) Then If wGameOver = 0 and wMovingNow = 0 Then wMovingNow = 1 ' to disable event wGetNextMoves() ' Next moves list 'wDispNextMoves() If wmc>0 Then wdepth = 1 wScanNextMoves() 'Scan them and calculate best evaluation 'TextWindow.WriteLine(wmove) wDoMove() wmovedX = wmvhist[whist][3] 'lastmove wmovedY = wmvhist[whist][4] 'next tick will read status Else 'what's the status on board? wLocateKingPos() wIsCheck() If wcheck = 1 Then wmvhist[whist][8]="#" 'checkmate wResult = Text.GetSubText("1-0,0-1", 1+((wturn+1)*2), 3) Else wResult = "{Stalemate} 1/2-1/2" EndIf TextWindow.WriteLine("GAME OVER!") wGameOver = 1 EndIf wGetFEN() TextWindow.WriteLine("FEN:" + wFEN) wHistToPgn() TextWindow.WriteLine("PGN:" + wpgn) wDrawBoard() wMovingNow = 0 EndIf EndIf EndIf EndIf EndIf EndSub Sub wCleaCurs wdragX = 0 ' mouse cursor on board wdragY = 0 wmovedX = 0 'lastmove wmovedY = 0 EndSub Sub OnMouseDown If Mouse.IsLeftButtonDown Then 'If button pressed wmX = GraphicsWindow.MouseX 'windowed X wmY = GraphicsWindow.MouseY 'windowed Y If 1=2 Then Else If wauto = 0 and wMovingNow = 0 Then ' If auto-mode is off If wturn = wside Then ' If our move then allow mouse control wMovingNow = 1 ' disable events wmatX = Math.Floor((wmX)/54) + 1 wmatY = 9 - Math.Floor((wmY+54)/54) If wside<0 Then wmatX = 9-wmatX wmatY = 9-wmatY EndIf If wmatX>=1 And wmatX<=8 And wmatY>=1 And wmatY<=8 Then wGetNextMoves() ' Next moves list 'wDispNextMoves() For wi = 1 To wmc If wmatX = wmv[wi][1] and wmatY = wmv[wi][2] Then wdragX = wmatX wdragY = wmatY EndIf If wdragX > 0 Then ' drag if there is a move from square If wmatX = wmv[wi][3] and wmatY = wmv[wi][4] Then If wdragX = wmv[wi][1] and wdragY = wmv[wi][2] Then wFormateMove() wDoMove() wCleaCurs() wmovedX = wmatX wmovedY = wmatY EndIf EndIf EndIf EndFor wDrawBoard() 'and redraw cursors EndIf wMovingNow = 0 EndIf EndIf EndIf EndIf EndSub Sub wInitVars wStartFEN = "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" ' position for checkmate in one move 'wStartFEN = "7k/Q7/5K2/8/8/8/8/8 w - - 1 1" wpEv[1]=100 wpEv[2]=280 wpEv[3]=300 wpEv[4]=500 wpEv[5]=900 wpEv[6]=9999 wpPtY[1]=8 wpPtY[2]=7 wpPtY[3]=4 wpPtY[4]=2 wpPtY[5]=5 wpPtY[6]=1 'pictures of pieces on inernet 'wImgSrc = "http://chessforeva.appspot.com/d_img/" wLoadImages() 'Load them into memory (takes time once) wauto = 0 'Set autogame on - presentation mode 'wAutoPlay() wdragX = 0 ' mouse cursor on board wdragY = 0 wmovedX = 0 ' to see the last move on board wmovedY = 0 wside = ((Math.GetRandomNumber(2)-1)*2)-1 'random white=1, black = -1 wMovingNow = 0 wtakeback = 0 wnewgame = 1 'This will set all other variables on timer tick OnTimerTick() 'And process it EndSub Sub wSetFEN'------------------------------------------------- sets position from FEN wq = 1 For wx = 1 To 8 For wy = 1 To 8 wB[wx][wy] = " " EndFor EndFor 'flags For current position wfl[1][1] = 0 'wK castling wfl[1][2] = 0 'wQ castling wfl[2][1] = 0 'bK castling wfl[2][2] = 0 'bQ castling wfl[3] = 0 'enpassant column wMvNr = 0 'move number wx = 1 wy = 8 wn = 0 For wi=1 To Text.GetLength(wFEN) wc = Text.GetSubText(wFEN,wi,1) If wc=" " Then wq = wq+1 Else If wq = 1 Then ' reading board If Text.IsSubText("PNBRQKpnbrqk", wc) Then wB[wx][wy] = wc wx = wx + 1 Else If wc="/" Then wy = wy-1 wx = 1 Else wn = Text.GetIndexOf("0123456789", wc)-1 wx = wx + wn EndIf EndIf EndIf If wq = 2 Then ' reading turn info If wc = "w" Then wturn = 1 Else wturn = -1 EndIf EndIf If wq = 3 Then ' reading castling info If wc="K" Then wfl[1][1] = 1 EndIf If wc="Q" Then wfl[1][2] = 1 EndIf If wc="k" Then wfl[2][1] = 1 EndIf If wc="q" Then wfl[2][2] = 1 EndIf EndIf If wq = 4 Then ' reading en-passant info wn = Text.GetIndexOf("abcdefgh", wc) If wn>0 Then wfl[3] = wn EndIf EndIf ' ignore 50-move info If wq = 6 Then ' reading move number wMvNr = (wMvNr * 10) + (Text.GetIndexOf("0123456789", wc)-1) EndIf EndIf EndFor ' prepares for new game whist = 0 wGameOver = 0 wMovingNow = 0 wResult = "" wnewgame = 0 wLocateKingPos() wIsCheck() EndSub Sub wGetFEN'------------------------------------------------- gets FEN from position wFEN = "" wq = 0 For wy = 8 To 1 Step -1 For wx = 1 To 8 wc = wB[wx][wy] If wc = " " Then wq = wq+1 Else If wq>0 Then wFEN = wFEN + Text.GetSubText("12345678",wq,1) wq = 0 EndIf wFEN = wFEN + wc EndIf EndFor If wq>0 Then wFEN = wFEN + Text.GetSubText("12345678",wq,1) wq = 0 EndIf If wy>1 Then wFEN = wFEN + "/" EndIf EndFor wFEN = wFEN + " " If wturn>0 Then ' turn wFEN = wFEN + "w" Else wFEN = wFEN + "b" EndIf wFEN = wFEN + " " wc = "" ' castling info If wfl[1][1]>0 Then wc=wc+"K" EndIf If wfl[1][2]>0 Then wc=wc+"Q" EndIf If wfl[2][1]>0 Then wc=wc+"k" EndIf If wfl[2][2]>0 Then wc=wc+"q" EndIf If Text.GetLength(wc) = 0 Then wc = "-" EndIf wFEN = wFEN + wc + " " If wfl[3]>0 Then ' en-passant info wc = Text.GetSubText("abcdefgh", wfl[3],1) If wturn>0 Then wc = wc + "6" Else wc = wc + "3" EndIf Else wc = "-" EndIf wFEN = wFEN + wc + " 0 " + (wMvNr) EndSub Sub wDispNextMoves'----------------------------- displays to screen next legal moves Stack.PushValue("p",wmove) wout = "" For wi = 1 To wmc wFormateMove() wout = wout + wmove + ";" EndFor TextWindow.WriteLine(wout) wmove = Stack.PopValue("p") EndSub Sub wFormateMove wmove = "" wmove = wmove + Text.GetSubText("abcdefgh", wmv[wi][1],1) wmove = wmove + Text.GetSubText("12345678", wmv[wi][2],1) wmove = wmove + Text.GetSubText("abcdefgh", wmv[wi][3],1) wmove = wmove + Text.GetSubText("12345678", wmv[wi][4],1) wmove = wmove + wmv[wi][5] EndSub Sub wHistToPgn '-- convert saved history to normal chess game notation format (pgn) wpgn = "" For wi = 1 To whist If Math.Remainder(wi,2)>0 Then wpgn = wpgn + ((wi+1)/2) + "." EndIf wc = wmvhist[wi][6] If Text.IsSubText(wc,"0-") Then wpgn = wpgn + wc Else If wc <> "p" Then wpgn = wpgn + wc 'piece EndIf wpgn = wpgn + Text.GetSubText("abcdefgh",wmvhist[wi][1],1) wpgn = wpgn + Text.GetSubText("12345678",wmvhist[wi][2],1) wpgn = wpgn + wmvhist[wi][7] ' goes to wpgn = wpgn + Text.GetSubText("abcdefgh",wmvhist[wi][3],1) wpgn = wpgn + Text.GetSubText("12345678",wmvhist[wi][4],1) wpgn = wpgn + wmvhist[wi][5] 'promotes wpgn = wpgn + wmvhist[wi][8] 'check EndIf wpgn = wpgn + " " EndFor wpgn = wpgn + wResult EndSub Sub wGetNextMoves'---- genereates array of all current legal moves that are possible Stack.PushValue("p",wmove) wmove = "" While wmc > 0 Array.RemoveValue(wmv,wmc) wmc = wmc-1 EndWhile For wx = 1 To 8 For wy = 1 To 8 If wB[wx][wy]<>" " Then wn = Text.GetIndexOf(" PNBRQKpnbrqk", wB[wx][wy])-1 wenm = Text.GetSubText( "pnbrqkPNBRQK", wn-Math.Remainder(wn-1,6), 6 ) If wturn<0 Then wn = wn - 6 ' the same for both sides EndIf If wn = 1 Then wGenNpawn() EndIf If wn = 2 Then wGenNknight() EndIf If wn = 3 Or wn = 5 Then wGenNbishop() EndIf If wn = 4 Or wn = 5 Then wGenNrook() EndIf If wn = 6 Then wGenNking() EndIf EndIf EndFor EndFor wmove = Stack.PopValue("p") EndSub Sub wGenNpawn' -------------------------------------------------------- Pawn's moves wdy = wturn If wB[wx][wy+wdy] = " " Then 'go square forward wdx = 0 wAddMoveV() wdy = wdy+wturn ' try 2nd square forward If Math.Remainder(wy-wdy,9)=0 Then ' 2,7 horiz. If wB[wx][wy+wdy] = " " Then wAddMoveV() EndIf EndIf wdy = wdy-wturn EndIf For wdx = -1 To 1 Step 2 ' try to capture If wx+wdx>0 and wx+wdx<9 Then If Text.IsSubText( wenm, wB[wx+wdx][wy+wdy] ) Then wAddMoveV() Else If wx+wdx= wfl[3] Then If Math.Remainder(wy-(5*wdy),11)=0 Then '4, 5 horiz. If wB[wx+wdx][wy+wdy] = " " Then If Text.IsSubText( wenm, wB[wx+wdx][wy] ) Then wAddMoveV() ' en-passant EndIf EndIf EndIf EndIf EndIf EndIf EndFor EndSub Sub wGenNknight'----------------------------------------------------- Knight's moves For wdx = -2 To 2 If wx+wdx>0 and wx+wdx<9 Then For wdy = -2 To 2 If wy+wdy>0 and wy+wdy<9 Then If Math.Abs(wdx)+ Math.Abs(wdy)=3 Then 'all 2+1 combinations If Text.IsSubText( " "+wenm, wB[wx+wdx][wy+wdy] ) Then wAddMoveV() EndIf EndIf EndIf EndFor EndIf EndFor EndSub Sub wGenNbishop'--------------------------------------- Bishop's (and queen's) moves For wdi1 = -1 To 1 Step 2 For wdi2 = -1 To 1 Step 2 wdx = 0 wdy = 0 For wdi3 = 1 To 7 wdx = wdx + wdi1 ' diognals wdy = wdy + wdi2 If wx+wdx<1 or wx+wdx>8 or wy+wdy<1 or wy+wdy>8 Then wdi3 = 9 Else If Text.IsSubText( " "+wenm, wB[wx+wdx][wy+wdy] ) Then wAddMoveV() EndIf If wB[wx+wdx][wy+wdy]<>" " Then wdi3 = 9 EndIf EndIf EndFor EndFor EndFor EndSub Sub wGenNrook'------------------------------------------- Rook's (and queen's) moves For wdi1 = -1 To 1 For wdi2 = -1 To 1 If Math.Abs(wdi1)+ Math.Abs(wdi2)=1 Then ' verticals and horizontals wdx = 0 wdy = 0 For wdi3 = 1 To 7 wdx = wdx + wdi1 wdy = wdy + wdi2 If wx+wdx<1 or wx+wdx>8 or wy+wdy<1 or wy+wdy>8 Then wdi3 = 9 Else If Text.IsSubText( " "+wenm, wB[wx+wdx][wy+wdy] ) Then wAddMoveV() EndIf If wB[wx+wdx][wy+wdy]<>" " Then wdi3 = 9 EndIf EndIf EndFor EndIf EndFor EndFor EndSub Sub wGenNking'--------------------------------------------------------- King's moves For wdj1 = -1 To 1 If wx+wdj1>0 and wx+wdj1<9 Then For wdj2 = -1 To 1 If wy+wdj2>0 and wy+wdj2<9 Then If wdj1<>0 or wdj2<>0 Then If Text.IsSubText( " "+wenm, wB[wx+wdj1][wy+wdj2] ) Then wx = wx + wdj1 wy = wy + wdj2 wisCheck() wx = wx - wdj1 wy = wy - wdj2 If wcheck = 0 Then wdx = wdj1 wdy = wdj2 wAddMove() EndIf EndIf EndIf EndIf EndFor EndIf EndFor 'Add castling moves, If no check and castling possible wdj1 = 1+((1-wturn)/2) '1,2 - for castling flags wdj11 = ((wdj1-1)*7)+1 '1,8 - king's line wcheck = -9 If (wfl[wdj1][1]+wfl[wdj1][2])>0 Then wdj3 = 0 For wdj2 = -1 To 1 Step 2 wdj22 = wdj2*2 wdj3 = wdj3 + 1 If wfl[wdj1][wdj3]>0 Then ' castling flag allows wdj42 = 3- ((wdj2+1)/2) For wdj4 = 1 To wdj42 If wB[5+(wdj2*wdj4)][wdj11]<>" " Then 'squares empty wdj4 = 9 EndIf EndFor If wdj4<5 Then If wcheck = -9 Then wisCheck() EndIf If wcheck = 0 Then For wdj4 = 1 To 2 wx = wx + wdj2 If wcheck = 0 Then wisCheck() EndIf EndFor wx = wx-wdj22 EndIf If wcheck = 0 Then wdy = 0 wdx =wdj22 wAddMove() EndIf EndIf EndIf EndFor EndIf EndSub Sub wLocateKingPos' -------------------- Locate king position before check detection wx = 1 wy = 1 wc2 = Text.GetSubText("k-K",wturn+2,1) While wy<9 and wB[wx][wy]<>wc2 wx = wx+1 If wx>8 Then wx = 1 wy = wy + 1 EndIf EndWhile EndSub Sub wIsCheck' ----------------------------- Detects If king's square is under attack wcheck = 0 For wdi1 = -1 To 1 For wdi2 = -1 To 1 If wdi1<>0 Or wdi2<>0 Then wdx = 0 wdy = 0 For wdi3 = 1 To 7 wdx = wdx + wdi1 ' diognals, verticals and horizontals wdy = wdy + wdi2 If wx+wdx<1 or wx+wdx>8 or wy+wdy<1 or wy+wdy>8 Then wdi3 = 9 Else wn = Text.GetIndexOf(" PNBRQKpnbrqk", wB[wx+wdx][wy+wdy])-1 If wn<>0 Then wn = wn - ((wturn+1) * 3) If wn = 1 Then 'oponent's pawn If Math.Abs(wdx) = 1 and wdy = wturn Then wcheck = 1 EndIf Else If wn = 3 Then 'oponent's bishop If Math.Abs(wdi1) + Math.Abs(wdi2) = 2 Then wcheck = 1 EndIf Else If wn = 4 Then 'oponent's rook If Math.Abs(wdi1) + Math.Abs(wdi2) = 1 Then wcheck = 1 EndIf Else If wn = 5 Then 'oponent's queen wcheck = 1 Else If wn = 6 Then 'oponent's king If Math.Abs(wdx)<2 and Math.Abs(wdy) < 2 Then wcheck = 1 EndIf EndIf EndIf EndIf EndIf EndIf If wcheck Then GraphicsWindow.ShowMessage("Check!" "Chess") wdi1 = 9 wdi2 = 9 EndIf wdi3 = 9 EndIf EndIf EndFor EndIf EndFor EndFor If wcheck = 0 Then 'maybe oponent's knight's check For wdx = -2 To 2 If wx+wdx>0 and wx+wdx<9 Then For wdy = -2 To 2 If wy+wdy>0 and wy+wdy<9 Then If Math.Abs(wdx) + Math.Abs(wdy) = 3 Then wn = Text.GetIndexOf(" PNBRQKpnbrqk", wB[wx+wdx][wy+wdy])-1 If wn>1 Then wn = wn - ((wturn+1) * 3) If wn = 2 Then 'oponent's knight wcheck = 1 wdx = 9 wdy = 9 EndIf EndIf EndIf EndIf EndFor EndIf EndFor EndIf EndSub Sub wAddMoveV'------ add and verify king's threat before put this move into the list (heavy, but proper) Stack.PushValue( "q", wcheck ) Stack.PushValue( "q", wB ) Stack.PushValue( "q", wx ) Stack.PushValue( "q", wy ) Stack.PushValue( "q", wdx ) Stack.PushValue( "q", wdy ) Stack.PushValue( "q", wdi1 ) Stack.PushValue( "q", wdi2 ) Stack.PushValue( "q", wdi3 ) Stack.PushValue( "q", wn ) wB[wx+wdx][wy+wdy] = wB[wx][wy] wB[wx][wy] = " " wLocateKingPos() wIsCheck() wn = Stack.PopValue("q") wdi3 = Stack.PopValue("q") wdi2 = Stack.PopValue("q") wdi1 = Stack.PopValue("q") wdy = Stack.PopValue("q") wdx = Stack.PopValue("q") wy = Stack.PopValue("q") wx = Stack.PopValue("q") wB = Stack.PopValue("q") If wcheck = 0 Then wAddMove() EndIf wcheck = Stack.PopValue("q") EndSub Sub wAddMove'--------------------------------------- add this legal move to the list wmc = wmc + 1 wmv[wmc][1] = wx wmv[wmc][2] = wy wmv[wmc][3] = wx+wdx wmv[wmc][4] = wy+wdy wmv[wmc][5] = "" EndSub Sub wScanNextMoves'-------------- Checking all generated moves, searches best answer (max. depth level 2) For wmi = 1 To wmc wPush() wMovePiece() If wdepth = 1 Then wEi = wmi wEv[wEi][1] = wE + (Math.GetRandomNumber(9)-5) wdepth = wdepth + 1 wGetNextMoves() ' Oponent's move If wmc > 0 Then wScanNextMoves() Else wLocateKingPos() wIsCheck() wEv[wEi][1] = 99999 * (-wturn) * (1+wcheck) ' go this case, or stalemate wEv[wEi][2] = 0 EndIf wdepth = wdepth - 1 wE = wEv[wEi][1]+wEv[wEi][2] ' Our move+ and oponent's answer- = evaluation Else If wdepth = 2 Then wEvN = 0 If wmi = 1 Then wEvN = 1 Else If wturn>0 Then If wEv[wEi][2] > wE Then wEvN = 1 ' seems strongest answer EndIf Else If wEv[wEi][2] < wE Then wEvN = 1 ' seems strongest answer EndIf EndIf EndIf If wEvN>0 Then wEv[wEi][2] = wE EndIf EndIf EndIf wPop() If wdepth = 1 Then wEvN = 0 If wmi = 1 Then wEvN = 1 Else If wturn>0 Then If wEvb < wE Then wEvN = 1 ' seems better after all, if we are white EndIf Else If wEvb > wE Then wEvN = 1 'seems better after all, if we are black EndIf EndIf EndIf If wEvN>0 Then wEvb = wE wi = wEi wFormateMove() 'wmove contains the best move EndIf EndIf EndFor EndSub Sub wDoMove'----------------------- - Process move from the list for normal notation ("e2e4") wGetNextMoves() For wmi = 1 To wmc If wmv[wmi][1] = Text.GetIndexOf("abcdefgh", Text.GetSubText(wmove,1,1) ) Then If wmv[wmi][2] = Text.GetIndexOf("12345678", Text.GetSubText(wmove,2,1) ) Then If wmv[wmi][3] = Text.GetIndexOf("abcdefgh", Text.GetSubText(wmove,3,1) ) Then If wmv[wmi][4] = Text.GetIndexOf("12345678", Text.GetSubText(wmove,4,1) ) Then wdepth = 0 'save to history whist = whist + 1 wmvhist[whist][1] = wmv[wmi][1] ' from wmvhist[whist][2] = wmv[wmi][2] wmvhist[whist][3] = wmv[wmi][3] ' to wmvhist[whist][4] = wmv[wmi][4] wmvhist[whist][5] = wmv[wmi][5] 'promo wmvhist[whist][6] = "" ' piece, or 0-0, or 0-0-0 wmvhist[whist][7] = "-" ' move, capture wmvhist[whist][8] = "" 'check wmvhist[whist][9] = wmove 'save move text wMovePiece() EndIf EndIf EndIf EndIf EndFor EndSub Sub wMovePiece'--------------- Moving piece on board and counting eval. improvements (+=white, -=black) wE = 0 wfl[3] = 0 wn = Text.GetIndexOf(" PNBRQKpnbrqk", wB[wmv[wmi][3]][wmv[wmi][4]])-1 If wn>0 Then If wturn>0 Then wn = wn - 6 EndIf If wn>0 And wn<7 Then wE = wE + (wturn * wpEv[wn]) ' Got points by capturing enemy's piece If wdepth = 0 Then 'save to history wmvhist[whist][7] = "x" EndIf EndIf EndIf wn = Text.GetIndexOf(" PNBRQKpnbrqk", wB[wmv[wmi][1]][wmv[wmi][2]])-1 If wn>0 Then If wturn<0 Then wn = wn - 6 EndIf If wdepth = 0 Then 'save to history wmvhist[whist][6] = Text.GetSubText("pNBRQK",wn,1) ' piece EndIf ' Moving piece's evaluations If wn = 1 Then If wmv[wmi][1]<>wmv[wmi][3] and wB[wmv[wmi][3]][wmv[wmi][4]] = " " Then wB[wmv[wmi][3]][wmv[wmi][2]] = " " 'en-passant wE = wE + (wturn * wpEv[1]) If wdepth = 0 Then 'save to history wmvhist[whist][7] = "x" EndIf Else If Math.Abs( wmv[wmi][4]-wmv[wmi][2] ) = 2 Then wfl[3] = wmv[wmi][1] 'remember enpassant column EndIf EndIf For wdi1 = 1 To 8 Step 7 If wmv[wmi][4] = wdi1 Then 'promoted to queen If Text.GetLength(wmove)>4 Then wdi2 = Text.GetIndexOf("nbrq",Text.GetSubText(wmove,5,1)) ' given Else wdi2 = 4 'queen EndIf wmv[wmi][5]= Text.GetSubText("nbrq",wdi2,1) If wdepth = 0 Then 'save to history wmvhist[whist][5] = "=" + wmv[wmi][5] EndIf wB[wmv[wmi][1]][wmv[wmi][2]] = Text.GetSubText("-nbrq---NBRQ", wdi1+wdi2,1) wE = wE + (wturn * (wpEv[5]-wpEv[1])) EndIf EndFor EndIf If wn = 2 or wn = 3 Then 'knight or bishop 'should attack king EndIf If wn = 5 Then 'queen 'should attack king EndIf If wn = 6 Then 'king 'If it is a castling or move away from e1,e8 If wmv[wmi][1] = 5 Then wdi3 = wmv[wmi][3]-wmv[wmi][1] wdj1 = 1+((1-wturn)/2) '1,2 - for castling flags If Math.Abs(wdi3)>1 Then wdi2 = wmv[wmi][2] '1,8 - castling wdi4 = 1+(7*((wdi3+2)/4)) '1,8 Rook wB[5+(wdi3/2)][wdi2] = wB[wdi4][wdi2] wB[wdi4][wdi2] = " " wE = wE + (200 * wturn) ' castle If possible If wdepth = 0 Then 'save to history wdi4 = 5-(((wdi3+2)/4)*2) '5,3 length wmvhist[whist][6] = Text.GetSubText("0-0-0",1,wdi4) EndIf Else If (wfl[wdj1][1]+wfl[wdj1][2])>0 Then wE = wE - (200 * wturn) EndIf EndIf wfl[wdj1][1] = 0 wfl[wdj1][2] = 0 EndIf EndIf ' add points for y-position (attack forward) wE = wE + ((wmv[wmi][4] - wmv[wmi][2]) * wpPtY[wn]) ' add points for x-position (center) wE = wE + (wturn * (18 - Math.Abs(9 - (2*wmv[wmi][3])))) wB[wmv[wmi][3]][wmv[wmi][4]] = wB[wmv[wmi][1]][wmv[wmi][2]] wB[wmv[wmi][1]][wmv[wmi][2]] = " " 'If rook moved or was captured For wdj1 = 1 To 8 Step 7 'a,h wdj22 = 2-((wdj1-1)/7) '1,2 For wdj2 = 1 To 8 Step 7 '1,8 wdj11 = 1+((wdj2-1)/7) '1,2 wdj23 = (wdj11*2)-3 '1,-1 wdj24 = 0 If (wmv[wmi][1] = wdj1 and wmv[wmi][2] = wdj2) Then wdj24 = 1 EndIf If (wdj24 = 0) And (wmv[wmi][3] = wdj1 and wmv[wmi][4] = wdj2) Then wdj24 = 1 EndIf If wdj24 = 1 and wfl[wdj11][wdj22] > 0 Then wfl[wdj11][wdj22] = 0 wE = wE + (80 * wdj23) ' penalty for lost castling EndIf EndFor EndFor EndIf ' motivate center, knights,bishops If wMvNr<10 Then wdj23 = 8-(((wturn+1)/2)*7) '1,8 For wdj1 = 2 To 7 If Math.Abs(9 - wdj1)>1 and Text.IsSubText("NBnb", wB[wdj1][wdj23]) Then wE = wE - (wturn * (5*wMvNr)) ' penalty for long sitting in back EndIf EndFor If wMvNr<8 Then For wdj1 = 4 To 5 If Text.IsSubText("pP",wB[wdj1][wdj23+wturn]) Then wE = wE - (wturn * 60) ' penalty for not taking the center EndIf EndFor EndIf EndIf wturn = -wturn If wturn>0 Then wMvNr = wMvNr + 1 ' increase move-counter EndIf wLocateKingPos() wIsCheck() If wcheck>0 Then ' Add extra points for check wE = wE - (50 * wturn) If wdepth = 0 Then 'save to history wmvhist[whist][8] = "+" 'check EndIf EndIf EndSub Sub wPush'------------------------------------------- Save current position in stack Stack.PushValue("p", wfl) Stack.PushValue("p", wturn) Stack.PushValue("p", wMvNr) Stack.PushValue("p", wmv) Stack.PushValue("p", wmc) Stack.PushValue("p", wmi) Stack.PushValue("p", wB) Stack.PushValue("p", wmove) EndSub Sub wPop'----------------------------------------------- Restore position from stack wmove = Stack.PopValue("p") wB = Stack.PopValue("p") wmi = Stack.PopValue("p") wmc = Stack.PopValue("p") wmv = Stack.PopValue("p") wMvNr = Stack.PopValue("p") wturn = Stack.PopValue("p") wfl = Stack.PopValue("p") EndSub Sub wDoTakeBack'------------------------- reproduces all moves till current position wtbh = whist - 2 If wtbh >= 0 Then wFEN = wStartFEN wSetFEN() 'set starting position For wtbi = 1 To wtbh 'do movements wmove = wmvhist[wtbi][9] wDoMove() EndFor For wtbi = 1 To 2 'remove 2 movements Array.RemoveValue(wmvhist,wtbh+1) EndFor EndIf wtakeback = 0 EndSub Sub wLoadImages wGrH = (54*8) wGrW = (54*8) + (92) GraphicsWindow.Title = "SB Chess presentation" GraphicsWindow.Height = wGrH GraphicsWindow.Width = wGrW 'GraphicsWindow.DrawBoundText(wGrW/2.2,wGrH/2.2, 100, "Loading...") wImgPc[1][2] = LDCall.Function2("mkfig" "b" "p") 'bp wImgPc[2][2] = LDCall.Function2("mkfig" "b" "n") 'bn wImgPc[3][2] = LDCall.Function2("mkfig" "b" "b") 'bb wImgPc[4][2] = LDCall.Function2("mkfig" "b" "r") 'br wImgPc[5][2] = LDCall.Function2("mkfig" "b" "q") 'bq wImgPc[6][2] = LDCall.Function2("mkfig" "b" "k") 'bk wImgPc[1][1] = LDCall.Function2("mkfig" "w" "p") 'wp wImgPc[2][1] = LDCall.Function2("mkfig" "w" "n") 'wn wImgPc[3][1] = LDCall.Function2("mkfig" "w" "b") 'wb wImgPc[4][1] = LDCall.Function2("mkfig" "w" "r") 'wr wImgPc[5][1] = LDCall.Function2("mkfig" "w" "q") 'wq wImgPc[6][1] = LDCall.Function2("mkfig" "w" "k") 'wk 'And also draw buttons GraphicsWindow.BackgroundColor = "#30C8CF" Stack.PushValue("g",GraphicsWindow.BrushColor) GraphicsWindow.FontSize=14 GraphicsWindow.BrushColor = "#0000FF" Controls.AddButton("NewGam" (54*8)+15,60) cb=ldControls.AddCheckBox("AutoPlay") LDControls.CheckBoxChanged=chbc Controls.Move(CB 54*8+15,110) Controls.AddButton("Undo" (54*8)+15,160) GraphicsWindow.BrushColor = Stack.PopValue("g") cuu=Shapes.AddEllipse(50 50) LDShapes.BrushColour(cuu "#99ffffff") LDShapes.PenWidth(cuu 0) LDEffect.DropShadow(cuu "color=darkblue") Controls.ButtonClicked=bcc 'LDShapes.PenColour(cuu "red") EndSub Sub chbc If LDControls.CheckBoxGetState(cb) Then wauto = 1 'auto game on/off Else wauto=0 EndIf EndSub Sub bcc lbb=Controls.LastClickedButton If Text.EndsWith(lbb "1") Then wnewgame = 1 Else wtakeback = 1 EndIf wCleaCurs() EndSub Sub mkfig GraphicsWindow.BrushColor="white GraphicsWindow.FillRectangle(0 0 100 100) GraphicsWindow.FontName="SEGOE UI" GraphicsWindow.FontSize=45 clr["b"]="#0000A0 clr["w"]="darkred chf = "P=265F;N=265E;B=265D;R=265C;Q=265B;K=265A GraphicsWindow.FontBold="true GraphicsWindow.BrushColor="#eeffff GraphicsWindow.DrawText(2, -7 text.GetCharacter(LDMath.Base2Decimal( chf[args[2]] 16))) GraphicsWindow.FontBold="false GraphicsWindow.BrushColor=clr[args[1]] GraphicsWindow.DrawText(2, -7 text.GetCharacter(LDMath.Base2Decimal( chf[args[2]] 16))) Program.Delay(55) cc=ldGraphicsWindow.Capture("" "false") Program.Delay(99) LDImage.ReplaceColour(cc "#FFFFFF" "#000000" 5) LDImage.MakeTransparent(cc "#000000") LDImage.Crop(cc 0 0 70 70) GraphicsWindow.FontSize=14 return=cc EndSub Sub wDrawBoard ss=LDShapes.GetAllShapes() For xs=1 To Array.GetItemCount(ss) If Text.StartsWith(ss[xs] "I") Then Shapes.Remove(ss[xs]) EndIf EndFor For wdi1 = 1 To 8 For wdi2 = 1 To 8 wdi11 = (wdi1-1) wdi22 = (8-wdi2) If wside<0 Then wdi11 = 7-wdi11 wdi22 = 7-wdi22 EndIf 'Board squares wi = 7+((1-Math.Remainder(wdi1+wdi2,2))*14) Stack.PushValue("g",GraphicsWindow.BrushColor) GraphicsWindow.BrushColor = Text.GetSubText("white:#E7CEA5,black:#A57B5A",wi,7) GraphicsWindow.FillRectangle(wdi11*54, wdi22*54, 54, 54) wc = wB[wdi1][wdi2] 'Pieces on board If wc <> " " Then wi = Text.GetIndexOf("pnbrqkPNBRQK", wc) wn = 2 wc2 = "color=gray" If wi > 6 Then wi = wi - 6 wn = 1 wc2 = "Color=white" EndIf GraphicsWindow.BrushColor = wc2 ss=Shapes.AddImage(wImgPc[wi][wn]) LDEffect.DropShadow(ss wc2) shapes.Move(ss wdi11*54, wdi22*54) GraphicsWindow.BrushColor = Stack.PopValue("g") EndIf ' cursor for mouse drags If wdi1 = wdragX And wdi2 = wdragY Then wc2 = "#FF0000" ' red wDrawCursor() EndIf ' last move on board If wdi1 = wmovedX And wdi2 = wmovedY Then wc2 = "#0000FF" ' blue wDrawCursor() EndIf EndFor EndFor EndSub Sub wDrawCursor LDShapes.ZIndex(cuu, -1) Shapes.Move(cuu (wdi11*54)+1, (wdi22*54)+1) EndSub End>QXQ421.sb< Start>QXQ571.sb< 'Simon Letters -- Project idea for the topic of Files and Arrays 'Matthew L. Parets TextWindow.ForegroundColor = "black" TextWindow.BackgroundColor = "white" TextWindow.Clear() TextWindow.ForegroundColor = "red" TextWindow.WriteLine("Simon Letters") TextWindow.ForegroundColor = "black" TextWindow.WriteLine("During its turn the computer will give you a list of letters. During your turn,") TextWindow.WriteLine("you have to enter the letters in the same order that the computer displayed") TextWindow.WriteLine("them. If you make a mistake the game is over. Good Luck!") TextWindow.WriteLine("") letterList[1] = "A" letterList[2] = "B" letterList[3] = "C" letterList[4] = "D" roundNumber = 0 match = "true" While match = "true" roundNumber = roundNumber + 1 newChoice = Math.GetRandomNumber(4) computerList[roundNumber] = letterList[newChoice] TextWindow.Write("Round ") TextWindow.WriteLine(roundNumber) TextWindow.WriteLine("Computers Turn:") TextWindow.WriteLine("") For i = 1 To roundNumber TextWindow.WriteLine(computerList[i]) EndFor TextWindow.WriteLine("") TextWindow.WriteLine("Press ENTER to take your turn") enter = TextWindow.Read() 'This is just to pause the program, value is not needed TextWindow.Clear() TextWindow.WriteLine("Players Turn -- Repeat the numbers that the computer displayed") TextWindow.WriteLine("") For j = 1 To roundNumber TextWindow.Write("Letter ") TextWindow.Write(j) TextWindow.Write(": ") letter = TextWindow.Read() letter = Text.ConvertToUpperCase(letter) playerList[j] = letter EndFor TextWindow.WriteLine("") match = "true" For k = 1 To roundNumber TextWindow.Write(computerList[k]) TextWindow.Write(" --> ") TextWindow.Write(playerList[k]) If computerList[k] <> playerList[k] then match = "false" TextWindow.WriteLine(" Buzzz!") Else TextWindow.Writeline(" :-)") EndIf EndFor TextWindow.WriteLine("") If match = "true" Then TextWindow.WriteLine("Sucess!!") Else TextWindow.WriteLine("Buzzzz --- Sorry, you missed") TextWindow.Write("Good game, you reached round ") TextWindow.WriteLine(roundNumber) EndIf TextWindow.WriteLine("") TextWindow.WriteLine("Press ENTER to continue") enter = TextWindow.Read() 'This is just to pause the program, value is not needed TextWindow.Clear() EndWhile TextWindow.WriteLine("Thank you, Come again!") End>QXQ571.sb< Start>QXR238-0.sb< ' Maior & Menor '=========== 'Variáveis usadas neste programa: ' número[], índice, entrada, média, maior, menor, tecla, ESC TextWindow.Title= "Maior & Menor de 3 nºs Inteiros ESC= Text.GetCharacter(27) ' Código ASCII pra tecla "Esc" LF= Text.GetCharacter(10) ' Pula 1 linha (Line Feed) 'Seção 1 'Receber a entrada dos 3 números: Início: TextWindow.Clear() TextWindow.ForegroundColor= "Red TextWindow.WriteLine ("Digite 3 números inteiros confirmando cada um com a tecla :" + LF) TextWindow.ForegroundColor= "Blue For índice= 1 To 3 TextWindow.Write ("Digite número " + índice + ": ") número[índice]= TextWindow.ReadNumber() * 1 EndFor 'Seção 2 'Exibir os 3 números digitados: TextWindow.ForegroundColor= "DarkRed TextWindow.WriteLine (LF + "Os 3 números digitados foram os seguintes:") TextWindow.ForegroundColor= "DarkYellow For índice= 1 To 3 TextWindow.WriteLine ( índice + "º -> " + número[índice] ) EndFor 'Seção 3 'Calcular e mostrar a média dos 3 nºs: média= ( número[1] + número[2] + número[3] ) / 3 TextWindow.ForegroundColor= "Yellow TextWindow.WriteLine (LF + "Média dos 3 números -> " + média + LF) 'Seção 4 'Algoritmo pra determinar o maior e o menor valor digitado dentre os 3: If número[1] >= número[2] Then maior= número[1] menor= número[2] Else maior= número[2] menor= número[1] EndIf If número[3] > maior Then maior= número[3] EndIf If número[3] < menor Then menor= número[3] EndIf 'Método alternativo usando funções já disponíveis no MS Small BASIC: maior= Math.Max ( número[1], número[2] ) maior= Math.Max ( número[3], maior ) menor= Math.Min ( número[1], número[2] ) menor= Math.Min ( número[3], menor ) 'Seção 5 'Mostrar o resultado das comparações: TextWindow.ForegroundColor= "Green If maior <> menor Then TextWindow.WriteLine ("Maior valor -> " + maior) TextWindow.WriteLine ("Menor valor -> " + menor) Else TextWindow.WriteLine ("Ñ existem maior & menor números, pois os 3 são iguais a -> " + maior) EndIf 'Seção 6 'Decidir se encerra ou re-executa o programa dependendo ou ñ de a tecla 'Q' ou 'Esc' serem pressionadas TextWindow.ForegroundColor= "Magenta TextWindow.WriteLine (LF + "Pressione ou pra encerrar ou qualquer outra pra reiniciar...") tecla= Text.ConvertToUpperCase ( TextWindow.ReadKey() ) If tecla = "Q" Or tecla = ESC Then Program.End() EndIf Goto Início End>QXR238-0.sb< Start>QXR238-1.sb< ' Biggest & Smallest '============== TextWindow.Title= "Biggest & Smallest Outta 3 Numbers ESC= Text.GetCharacter(27) ' ASCII code for "Esc" key LF= Text.GetCharacter(10) ' Jumps 1 line (Line Feed) 'Section 1 'Recieves input for 3 numbers: Start: TextWindow.Clear() TextWindow.ForegroundColor= "Red TextWindow.WriteLine ("Type in 3 numbers confirming each one with key:" + LF) TextWindow.ForegroundColor= "Blue For index= 1 To 3 TextWindow.Write ("Number " + index + ": ") number[index]= TextWindow.ReadNumber() * 1 EndFor 'Section 2 'Displays the 3 typed numbers: TextWindow.ForegroundColor= "DarkRed TextWindow.WriteLine (LF + "These are the 3 numbers entered:") TextWindow.ForegroundColor= "DarkYellow For index= 1 To 3 TextWindow.WriteLine ( index + "-> " + number[index] ) EndFor 'Section 3 'Calculates the average outta 3 numbers: average= ( number[1] + number[2] + number[3] ) / 3 TextWindow.ForegroundColor= "Yellow TextWindow.WriteLine (LF + "Average for the 3 numbers-> " + average + LF) 'Section 4 'Algorithm to determine the biggest and the smallest outta 3 typed numbers: big= Math.Max ( number[1], number[2] ) big= Math.Max ( number[3], big ) small= Math.Min ( number[1], number[2] ) small= Math.Min ( number[3], small ) 'Section 5 'Mostrar o resultado das comparações: 'Displays the comparison result: TextWindow.ForegroundColor= "Green If big <> small Then TextWindow.WriteLine ("Biggest value-> " + big) TextWindow.WriteLine ("Smallest value-> " + small) Else TextWindow.WriteLine ("There are no biggest nor smallest values.") TextWindow.WriteLine ("All of them has the same value = " + big) EndIf 'Section 6 'Decides whether to end or restart the program depending on the key pressed TextWindow.ForegroundColor= "Magenta TextWindow.WriteLine (LF + "Press or to quit or any other to restart...") key= Text.ConvertToUpperCase ( TextWindow.ReadKey() ) If key = "Q" Or key = ESC Then Program.End() EndIf Goto Start End>QXR238-1.sb< Start>QXR238-2.sb< ' Biggest & Smallest '============== TextWindow.Title= "Biggest & Smallest Outta 3 Numbers ESC= Text.GetCharacter(27) ' ASCII code for "Esc" key LF= Text.GetCharacter(10) ' Jumps 1 line (Line Feed) 'Section 1 'Recieves input for 3 numbers: Start: TextWindow.Clear() TextWindow.ForegroundColor= "Red TextWindow.WriteLine ("Type in 3 numbers confirming each one with 'ENTER' key:" + LF) TextWindow.ForegroundColor= "Blue For index= 1 To 3 TextWindow.Write ("Number " + index + ": ") number[index]= TextWindow.ReadNumber() * 1 EndFor 'Section 2 'Displays the 3 typed numbers: TextWindow.ForegroundColor= "DarkRed TextWindow.WriteLine (LF + "These are the 3 numbers entered:") TextWindow.ForegroundColor= "DarkYellow For index= 1 To 3 TextWindow.WriteLine ( index + "-> " + number[index] ) EndFor 'Section 3 'Calculates the average outta 3 numbers: average= ( number[1] + number[2] + number[3] ) / 3 TextWindow.ForegroundColor= "Yellow TextWindow.WriteLine (LF + "Average for the 3 numbers-> " + average + LF) 'Section 4 'Algorithm to sort out from the smallest to biggest outta 3 typed numbers: For times= 1 To 2 For index= 1 To 2 If number[index] > number[index+1] Then aux= number[index] number[index]= number[index+1] number[index+1]= aux EndIf EndFor EndFor 'Section 5 'Displays the comparison result: TextWindow.ForegroundColor= "Green TextWindow.WriteLine ("The ordered numbers from smallest to biggest:") TextWindow.ForegroundColor= "Cyan For index= 1 To 3 TextWindow.Write ( number[index] + ", " ) EndFor 'Section 6 'Decides whether to end or restart the program depending on the key pressed TextWindow.ForegroundColor= "Magenta TextWindow.WriteLine (LF + LF + "Press 'Q' or 'Esc' to quit or any other to restart...") key= Text.ConvertToUpperCase ( TextWindow.ReadKey() ) If key = "Q" Or key = ESC Then Program.End() EndIf Goto Start End>QXR238-2.sb< Start>QXR238-3.sb< ' Biggest to Smallest '============== TextWindow.Title= "Biggest & Smallest Outta 3 Numbers ESC= Text.GetCharacter(27) ' ASCII code for "Esc" key LF= Text.GetCharacter(10) ' Jumps 1 line (Line Feed) 'Section 1 'Receives input for 3 numbers: Start: TextWindow.Clear() TextWindow.ForegroundColor= "Red TextWindow.WriteLine ("Type in 3 numbers confirming each one with 'ENTER' key:" + LF) TextWindow.ForegroundColor= "Blue For index= 1 To 3 TextWindow.Write ("Number " + index + ": ") number[index]= TextWindow.ReadNumber() * 1 EndFor 'Section 2 'Displays the 3 typed numbers: TextWindow.ForegroundColor= "DarkRed TextWindow.WriteLine (LF + "These are the 3 numbers entered:") TextWindow.ForegroundColor= "DarkYellow For index= 1 To 3 TextWindow.WriteLine ( index + "-> " + number[index] ) EndFor 'Section 3 'Calculates the average outta 3 numbers: average= ( number[1] + number[2] + number[3] ) / 3 TextWindow.ForegroundColor= "Yellow TextWindow.WriteLine (LF + "Average for the 3 numbers-> " + average + LF) 'Section 4 'Algorithm to sort out from the smallest to biggest outta 3 typed numbers: For times= 1 To 2 For index= 1 To 2 If number[index] > number[index+1] Then aux= number[index] number[index]= number[index+1] number[index+1]= aux EndIf EndFor EndFor 'Section 5 'Displays the comparison result: TextWindow.ForegroundColor= "Green TextWindow.WriteLine ("The ordered numbers from smallest to biggest:") TextWindow.ForegroundColor= "Cyan For index= 1 To 3 TextWindow.Write ( number[index] + ", " ) EndFor 'Section 6 'Decides whether to end or restart the program depending on the key pressed: TextWindow.ForegroundColor= "Magenta TextWindow.WriteLine (LF + LF + "Press 'Q' or 'Esc' to quit or any other to restart...") key= Text.ConvertToUpperCase ( TextWindow.ReadKey() ) If key = "Q" Or key = ESC Then Program.End() EndIf Goto Start End>QXR238-3.sb< Start>QXR238.sb< ' Maior & Menor '=========== 'Variáveis usadas neste programa: ' número[], índice, entrada, média, maior, menor, tecla, ESC TextWindow.Title= "Maior & Menor de 3 nºs Inteiros ESC= Text.GetCharacter(27) ' Código ASCII pra tecla "Esc" CR= Text.GetCharacter(13) ' Cariage Return. Pula 1 linha 'Seção 1 'Receber a entrada dos 3 números: Início: TextWindow.Clear() TextWindow.ForegroundColor= "Red TextWindow.WriteLine ("Digite 3 números inteiros confirmando cada um com a tecla ENTER:" + CR) TextWindow.ForegroundColor= "Blue For índice= 1 To 3 TextWindow.Write ("Digite número " + índice + ": ") entrada= TextWindow.ReadNumber() número[índice]= entrada ' Transfere o valor ajustado ao conjunto que guarda os nºs digitados EndFor 'Seção 2 'Exibir os 3 números digitados: TextWindow.ForegroundColor= "Red TextWindow.WriteLine (CR + "Os 3 números digitados foram os seguintes:") TextWindow.ForegroundColor= "DarkYellow For índice= 1 To 3 TextWindow.WriteLine ( índice + "º -> " + número[índice] ) EndFor 'Seção 3 'Calcular e mostrar a média dos 3 nºs: média= ( número[1] + número[2] + número[3] ) / 3 TextWindow.ForegroundColor= "Yellow TextWindow.WriteLine("") TextWindow.WriteLine ("Média dos 3 números -> " + média) TextWindow.WriteLine("") 'Seção 4 'Algoritmo pra determinar o maior e o menor valor digitado dentre os 3: If número[1] >= número[2] Then maior= número[1] menor= número[2] Else maior= número[2] menor= número[1] EndIf If número[3] > maior Then maior= número[3] EndIf If número[3] < menor Then menor= número[3] EndIf 'Método alternativo usando funções já disponíveis no MS Small BASIC: maior= Math.Max ( número[1], número[2] ) maior= Math.Max ( número[3], maior ) menor= Math.Min ( número[1], número[2] ) menor= Math.Min ( número[3], menor ) 'Seção 5 'Mostrar o resultado das comparações: TextWindow.ForegroundColor= "Green If maior <> menor Then TextWindow.WriteLine ("Maior valor -> " + maior) TextWindow.WriteLine ("Menor valor -> " + menor) Else TextWindow.WriteLine ("Ñ existem maior & menor números, pois os 3 são iguais a -> " + maior) EndIf 'Seção 6 'Decidir se encerra ou re-executa o programa dependendo ou ñ de a tecla 'Q' ou 'Esc' serem pressionadas TextWindow.ForegroundColor= "Magenta TextWindow.WriteLine("") TextWindow.WriteLine ("Pressione 'Q' ou 'Esc' pra encerrar ou qualquer outra pra reiniciar...") tecla= Text.ConvertToUpperCase ( TextWindow.ReadKey() ) If tecla = "Q" Or tecla = ESC Then Program.End() EndIf Goto Início End>QXR238.sb< Start>QXV457.sb< args=0 GraphicsWindow.PenWidth =1 GraphicsWindow.BackgroundColor="darkblue GraphicsWindow.PenColor="cyan ii=imagelist.LoadImage (Flickr.GetRandomPicture ("palazzo madama")) GraphicsWindow.Title="Italian senate tx= Shapes.AddText ("Madama") LDShapes.Font (tx "vivaldi" 20 "false" "false") ldShapes.Centre (tx 180 160) While "true i=i+1.5 If Math.Remainder (i 180)=0 Then ii=imagelist.LoadImage (Flickr.GetRandomPicture ("palazzo madama")) mo=mo+1 endif If Math.Remainder( mo 2)=0 then ff=math.Abs(LDMath.Sin (i))+.6 GraphicsWindow.PenWidth =math.Abs(LDMath.Sin (i))*9 Else ff=1 endif GraphicsWindow.PenColor=LDColours.HSLtoRGB (Math.Remainder (i 180) 1 .6) pldrw() If Math.Remainder( mo 2)=0 then ff=math.Abs(LDMath.Sin (i))+.6 GraphicsWindow.PenWidth =math.Abs(LDMath.Sin (i))*3 GraphicsWindow.PenColor="darkblue pldrw() endif GraphicsWindow.PenWidth =1 If Math.Remainder( mo 2)=1 then ff=math.Abs(LDMath.Sin (i))+.6 Else ff=1 endif LDShapes.penColour (tx GraphicsWindow.PenColor ) Shapes.Zoom (tx ff*5 3*ff) Program.Delay (25) If Math.Remainder( mo 2)=0 then GraphicsWindow.PenColor="darkblue ff=math.Abs(LDMath.Sin (i))+.6 GraphicsWindow.PenWidth =math.Abs(LDMath.Sin (i))*11 pldrw () else GraphicsWindow.DrawResizedImage (ii 0 0 GraphicsWindow.Width GraphicsWindow.Height) 'GraphicsWindow.BrushColor="darkblue 'GraphicsWindow.FillRectangle (0 0 330 230) endif endwhile Sub pldrw LDCall.Function2 ("ldrw" 35+65*ff 100) LDCall.Function2 ("ldrw" 35+71*ff 100) LDCall.Function2 ("adrw" 35+80*ff 100) LDCall.Function2 ("adrw" 35+35*ff 100) LDCall.Function2 ("zdrw" 35+110*ff 95) LDCall.Function2 ("zdrw" 35+127*ff 89) LDCall.Function2 ("odrw" 35+145*ff 100) LDCall.Function2 ("pdrw" 35 100) EndSub Sub ldrw LDCall.Function4("aline" args[1] args[2] 50*ff, -75) EndSub Sub lldrw oc= GraphicsWindow.PenColor GraphicsWindow.penColor=GraphicsWindow.BackgroundColor LDCall.Function4("aline" args[1] args[2] 40*ff, -75) GraphicsWindow.PenColor=oc LDCall.Function4("aline" mm[1] mm[2] 10*ff, -75) EndSub Sub odrw GraphicsWindow.DrawEllipse (args[1] args[2]-30*ff 28*ff 28*ff) EndSub Sub adrw s115=args[1] s100=args[2] GraphicsWindow.DrawEllipse (s115 s100-30*ff 28*ff 28*ff) LDCall.Function4("aline" s115+22*ff s100 30*ff, -75) endsub Sub pdrw s115=args[1] s100=args[2] GraphicsWindow.DrawEllipse (s115 s100-30*ff 28*ff 28*ff) LDCall.Function4("aline" s115+8*ff s100-30*ff, 50*ff, 180-75) endsub Sub ddrw s115=args[1] s100=args[2] GraphicsWindow.DrawEllipse (s115 s100-30*ff 28*ff 28*ff) LDCall.Function4("aline" s115+22*ff s100 50*ff, -75) endsub Sub zdrw s115=args[1] s100=args[2] LDCall.Function4("aline" s115 s100 30*ff, -55) GraphicsWindow.DrawLine (mm[1] mm[2] mm[1]-13*ff mm[2]) GraphicsWindow.DrawLine (s115 s100 s115+15*ff s100) endsub Sub aline mm= LDMath.Convert2Cartesian (args[1] args[2] args[3] args[4]) GraphicsWindow.DrawLine (args[1] args[2] mm[1] mm[2]) EndSub End>QXV457.sb< Start>QXW739.sb< ' The following line could be harmful and has been automatically commented. ' setting = File.GetSettingsFilePath() ' The following line could be harmful and has been automatically commented. ' todo = File.ReadContents(setting) continue = "True" While continue index = Array.GetAllIndices(todo) num = Array.GetItemCount(todo) For i = 1 To num TextWindow.WriteLine(i + " " + todo[index[i]]) EndFor TextWindow.WriteLine("") TextWindow.Write("? ") cmd = Text.ConvertToLowerCase(TextWindow.Read()) If cmd = "a" Then AddTODO() ElseIf Text.StartsWith(cmd, "d") Then DeleteTODO() ElseIf cmd = "q" Then continue = "False" Else ShowHelp() EndIf EndWhile ' The following line could be harmful and has been automatically commented. ' File.WriteContents(setting, todo) Sub AddTODO TextWindow.Write("TODO? ") title = TextWindow.Read() TextWindow.Write("Due date(yyyy-mm-dd)? ") until = TextWindow.Read() line = "" line["TODO"] = title line["until"] = until TextWindow.WriteLine(line) MakeID() While Array.ContainsIndex(todo, id) MakeID() EndWhile todo[id] = line EndSub Sub DeleteTODO n = Text.GetSubTextToEnd(cmd, 2) If 1 <= n And n <= num Then todo[index[n]] = "" EndIf EndSub Sub MakeID i = Math.GetRandomNumber(20) id = Text.GetSubText("BCDFGHJKLMNPQRSTVWXZ", i, 1) For i = 1 To 3 id = id + (Math.GetRandomNumber(10) - 1) EndFor EndSub Sub ShowHelp TextWindow.WriteLine("a : add TODO") TextWindow.WriteLine("d : delete TODO ") TextWindow.WriteLine("h : show this help") TextWindow.WriteLine("q : save and exit") EndSub End>QXW739.sb< Start>QXX945-0.sb< 'Mapping Sample '************************************************************************************** 'Details available @ http://rickmurphy.byethost5.com/SmallBasic/ProgramListing/Map/ 'Import: QXX945-0 Runs locally only! Updated November 26, 2014 '************************************************************************************** Initialise() '============================================================== 'MAIN LOOP While 0=0 'UPDATE PROGRAM If mouseMove Then mouseX = GraphicsWindow.MouseX mouseY = GraphicsWindow.MouseY pixel = GraphicsWindow.GetPixel(mouseX, mouseY) If pixel <> "#000000" And mouseX <= ImageList.GetWidthOfImage(map) Then Shapes.ShowShape(contextHelpFrame) Shapes.ShowShape(contextHelp) Else Shapes.HideShape(contextHelpFrame) Shapes.HideShape(contextHelp) EndIf mouseMove = "False" EndIf 'UPDATE SCREEN Shapes.Zoom(contextHelpFrame, legend[pixel]["scaleX"], 1) Shapes.SetText(contextHelp, legend[pixel]["name"]) Shapes.Move(contextHelpFrame, mouseX + 10, mouseY + 10) Shapes.Move(contextHelp, mouseX + 3 + 10, mouseY + 3 + 10) Program.Delay(20) EndWhile '=================================================================== 'SUBROUTINE(S) Sub Initialise 'SET CONSTANTS FONTSIZE = GraphicsWindow.FontSize BRUSHCOLOR = GraphicsWindow.BrushColor LF = Text.GetCharacter(10) 'SET LEGEND VALUES legend["#FF1493"] = "name=Lairmairrener;scaleX=2.25" 'deep pink legend["#00FF00"] = "name=Tommeginne;scaleX=2.2" 'lime legend["#00FFFF"] = "name=Tyerremotepanner;scaleX=3" 'cyan legend["#006400"] = "name=Pyemmairre;scaleX=2" 'darkgreen legend["#800000"] = "name=Paredarerme;scaleX=2.15" 'maroon legend["#808080"] = "name=where Hobart is;scaleX=2.6" 'gray legend["#0000FF"] = "name=Nuenonne;scaleX=1.7" 'blue legend["#FFD700"] = "name=Toogee;scaleX=1.28" 'gold legend["#800080"] = "name=Peerapper;scaleX=1.8" 'purple legend["#F4A460"] = "name=haven't told us yet;scaleX=3.05" 'sandybrown 'PRE SETUP MESSAGE GraphicsWindow.Title = "Loading..." GraphicsWindow.DrawText(20, GraphicsWindow.Height /2, "D/loading Map, please wait") 'LOAD ASSET(S) map = ImageList.LoadImage("http://rickmurphy.byethost5.com/SmallBasic/ProgramListing/Map/assets/images/map-of-tasmania.png") 'VALIDATE LOAD If ImageList.GetWidthOfImage(map) = 0 Then GraphicsWindow.ShowMessage("Check your connection and/or try again."+LF+"End Program?", "File Failed to Download") Program.End() EndIf 'WINDOW SETTINGS GraphicsWindow.Title = "Mapping Sample" GraphicsWindow.Width = ImageList.GetWidthOfImage(map) * 2.5 GraphicsWindow.Height = ImageList.GetHeightOfImage(map) + 20 GraphicsWindow.CanResize = "False" 'ADD CONTEXT SENSITIVE SHAPES GraphicsWindow.BrushColor = "LightGray" GraphicsWindow.PenWidth = 0.5 contextHelpFrame = Shapes.AddRectangle(40, 20) GraphicsWindow.BrushColor = "Black" contextHelp = Shapes.AddText("") Shapes.SetOpacity(contextHelpFrame, 85) Shapes.HideShape(contextHelpFrame) Shapes.HideShape(contextHelp) 'DRAW SCREEN GraphicsWindow.FontSize = 20 GraphicsWindow.BrushColor = BRUSHCOLOR GraphicsWindow.DrawText(ImageList.GetWidthOfImage(map) + 50, 10, "Indigenous Map" + LF + "of Tasmania") GraphicsWindow.FontSize = FONTSIZE GraphicsWindow.DrawText(ImageList.GetWidthOfImage(map) + 50, 120, "Move the mouse over the map" +LF+ "to reveal name of country") GraphicsWindow.DrawImage(map, 10, 10) 'REGISTER EVENT(S) GraphicsWindow.MouseMove = OnMouseMove EndSub '============================================================================== 'EVENT HANDLER(S) Sub OnMouseMove mouseMove = "True" EndSub End>QXX945-0.sb< Start>QZN342-2.sb< ' Turtle Dodger 0.4a ' Copyright (c) 2014 Nonki Takahashi. ' ' License: ' The MIT License (MIT) ' http://opensource.org/licenses/mit-license.php ' ' History: ' 0.4a 2014-04-17 Added opening. (QZN342-2) ' 0.3a 2014-04-02 Avoided to hold while Turtle moving. (QZN342-1) ' 0.2a 2014-04-02 Changed for Silverlight. (QZN342-0) ' 0.1a 2014-04-02 Created. (QZN342) ' title = "Turtle Dodger 0.4a" GraphicsWindow.Title = title debug = "True" Init() Opening() Game() Sub Opening url = "http://www.nonkit.com/smallbasic.files/" bigTurtle = Shapes.AddImage(url + "Turtle.png") Shapes.Move(bigTurtle, 180, 140) GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 50 x = (gw - 443) / 2 y = 40 GraphicsWindow.DrawText(x, y, title) Program.Delay(3000) GraphicsWindow.Clear() EndSub Sub Ready GraphicsWindow.FontSize = 40 rdy = Shapes.AddText("Ready?") x = (gw - 130) / 2 y = 100 Shapes.Move(rdy, x, y) For opacity = 100 To 0 Step -10 Shapes.SetOpacity(rdy, opacity) Program.Delay(200) EndFor Shapes.Remove(rdy) EndSub Sub Game Turtle.Speed = 7 Turtle.PenUp() x = gw / 2 y = gh - 40 If debug Then GraphicsWindow.BrushColor = "White" GraphicsWindow.FontSize = 12 pos = Shapes.AddText("(" + x + "," + y + ")") GraphicsWindow.PenWidth = 1 cross1 = Shapes.AddLine(0, -8, 0, 8) cross2 = Shapes.AddLine(-8, 0, 8, 0) Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) Shapes.Move(pos, gw - 100, 20) EndIf Turtle.MoveTo(x, y) Turtle.Angle = 0 Not = "False=True;True=False;" moving = "False" scrolling = "False" Ready() GraphicsWindow.KeyDown = OnKeyDown tick = "False" Timer.Interval = 1000 / 24 Timer.Tick = OnTick lastems = Clock.ElapsedMilliseconds obj["iMin"] = 1 While "True" If moving Then If key = "Left" Then Turtle.TurnLeft() Turtle.Move(30) Turtle.TurnRight() ElseIf key = "Right" Then Turtle.TurnRight() Turtle.Move(30) Turtle.TurnLeft() EndIf moving = "False" Else Program.Delay(100) EndIf EndWhile EndSub Sub Init gw = 598 gh = 428 GraphicsWindow.BackgroundColor = "DodgerBlue" GraphicsWindow.Width = gw GraphicsWindow.Height = gh color = "1=Orange;2=Cyan;3=Lime;" size = "1=20;2=16;3=12;" EndSub Sub OnTick If Not[scrolling] Then scrolling = "True" ems = Clock.ElapsedMilliseconds If ems - lastems > 500 Then AddObject() lastems = ems EndIf ScrollObject() scrolling = "False" EndIf If debug Then x = Math.Floor(Turtle.X) y = Math.Floor(Turtle.Y) Shapes.SetText(pos, "(" + x + "," + y + ")") Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) EndIf EndSub Sub ScrollObject iMin = obj["iMin"] iMax = obj["iMax"] For i = iMin To iMax x = obj[i]["x"] y = obj[i]["y"] + 5 If y > gh Then Shapes.Remove(obj[i]["obj"]) obj[i] = "" obj["iMin"] = i + 1 Else Shapes.Move(obj[i]["obj"], x, y) obj[i]["x"] = x obj[i]["y"] = y EndIf EndFor EndSub Sub AddObject iMax = obj["iMax"] + 1 obj["iMax"] = iMax GraphicsWindow.PenWidth = 1 type = Math.GetRandomNumber(3) obj[iMax]["type"] = type GraphicsWindow.BrushColor = color[type] sz = size[type] obj[iMax]["obj"] = Shapes.AddRectangle(sz, sz) x = Math.GetRandomNumber(gw - 20) + 10 y = -20 obj[iMax]["x"] = x obj[iMax]["y"] = y Shapes.Move(obj[iMax]["obj"], x, y) Shapes.Rotate(obj[iMax]["obj"], Math.GetRandomNumber(360)) EndSub Sub OnKeyDown If Not[moving] Then moving = "True" key = GraphicsWindow.LastKey EndIf EndSub End>QZN342-2.sb< Start>QZN342-3.sb< ' Turtle Dodger 0.5b ' Copyright (c) 2014 Nonki Takahashi. ' ' License: ' The MIT License (MIT) ' http://opensource.org/licenses/mit-license.php ' ' History: ' 0.5b 2014-04-17 Changed to detect collision. (QZN342-3) ' 0.4a 2014-04-17 Added opening. (QZN342-2) ' 0.3a 2014-04-02 Avoided to hold while Turtle moving. (QZN342-1) ' 0.2a 2014-04-02 Changed for Silverlight. (QZN342-0) ' 0.1a 2014-04-02 Created. (QZN342) ' title = "Turtle Dodger 0.5b" GraphicsWindow.Title = title debug = "False" Init() Opening() Game() Closing() Sub Closing Timer.Pause() Turtle.Turn(720) GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 40 x = (gw - 217) / 2 y = 100 GraphicsWindow.DrawText(x, y, "GAME OVER") Program.Delay(3000) EndSub Sub Opening url = "http://www.nonkit.com/smallbasic.files/" bigTurtle = Shapes.AddImage(url + "Turtle.png") Shapes.Move(bigTurtle, 180, 140) GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 50 x = (gw - 443) / 2 y = 40 GraphicsWindow.DrawText(x, y, title) Program.Delay(3000) GraphicsWindow.Clear() EndSub Sub Ready GraphicsWindow.FontSize = 40 rdy = Shapes.AddText("Ready?") x = (gw - 130) / 2 y = 100 Shapes.Move(rdy, x, y) For opacity = 100 To 0 Step -10 Shapes.SetOpacity(rdy, opacity) Program.Delay(200) EndFor Shapes.Remove(rdy) EndSub Sub Game Turtle.Speed = 7 Turtle.PenUp() x = gw / 2 y = gh - 40 GraphicsWindow.BrushColor = "White" GraphicsWindow.FontSize = 18 score = Shapes.AddText("0") Shapes.Move(score, 20, 20) If debug Then GraphicsWindow.BrushColor = "White" GraphicsWindow.FontSize = 12 pos = Shapes.AddText("(" + x + "," + y + ")") GraphicsWindow.PenWidth = 1 cross1 = Shapes.AddLine(0, -8, 0, 8) cross2 = Shapes.AddLine(-8, 0, 8, 0) Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) Shapes.Move(pos, gw - 100, 20) EndIf Turtle.MoveTo(x, y) Turtle.Angle = 0 Not = "False=True;True=False;" moving = "False" scrolling = "False" Ready() GraphicsWindow.KeyDown = OnKeyDown tick = "False" Timer.Interval = 1000 / 24 Timer.Tick = OnTick lastems = Clock.ElapsedMilliseconds obj["iMin"] = 1 While Not[cd] If moving Then If key = "Left" Then Turtle.TurnLeft() Turtle.Move(30) Turtle.TurnRight() ElseIf key = "Right" Then Turtle.TurnRight() Turtle.Move(30) Turtle.TurnLeft() EndIf moving = "False" Else Program.Delay(100) EndIf EndWhile EndSub Sub Init gw = 598 gh = 428 GraphicsWindow.BackgroundColor = "DodgerBlue" GraphicsWindow.Width = gw GraphicsWindow.Height = gh color = "1=Orange;2=Cyan;3=Lime;" size = "1=20;2=16;3=12;" passed = 0 cd = "False" ' collision detected EndSub Sub OnTick If Not[scrolling] Then scrolling = "True" ems = Clock.ElapsedMilliseconds If ems - lastems > 500 Then AddObject() lastems = ems EndIf ScrollObject() scrolling = "False" EndIf If debug Then x = Math.Floor(Turtle.X) y = Math.Floor(Turtle.Y) Shapes.SetText(pos, "(" + x + "," + y + ")") Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) EndIf EndSub Sub ScrollObject iMin = obj["iMin"] iMax = obj["iMax"] For i = iMin To iMax x = obj[i]["x"] y = obj[i]["y"] + 5 tx = Math.Floor(Turtle.X) ty = Math.Floor(Turtle.Y) d = Math.SquareRoot(Math.Power(tx - x, 2) + Math.Power(ty - y, 2)) If d < (size[obj[i]["type"]] + 16) / 2 Then cd = "True" ' collision detected Goto break EndIf If y > gh Then passed = passed + 1 Shapes.SetText(score, passed) Shapes.Remove(obj[i]["obj"]) obj[i] = "" obj["iMin"] = i + 1 Else Shapes.Move(obj[i]["obj"], x, y) obj[i]["x"] = x obj[i]["y"] = y EndIf EndFor break: EndSub Sub AddObject iMax = obj["iMax"] + 1 obj["iMax"] = iMax GraphicsWindow.PenWidth = 1 type = Math.GetRandomNumber(3) obj[iMax]["type"] = type GraphicsWindow.BrushColor = color[type] sz = size[type] obj[iMax]["obj"] = Shapes.AddRectangle(sz, sz) x = Math.GetRandomNumber(gw - 20) + 10 y = -20 obj[iMax]["x"] = x obj[iMax]["y"] = y Shapes.Move(obj[iMax]["obj"], x, y) Shapes.Rotate(obj[iMax]["obj"], Math.GetRandomNumber(360)) EndSub Sub OnKeyDown If Not[moving] Then moving = "True" key = GraphicsWindow.LastKey EndIf EndSub End>QZN342-3.sb< Start>QZN342-6.sb< ' Turtle Dodger 0.7b ' Copyright © 2014-2017 Nonki Takahashi. The MIT License. ' ' History: ' 0.7b 2017-09-01 Supported USB Controller. (QZN342-6) ' 0.6b 2014-07-30 Changed image and sorted subroutines. (QZN342-4) ' 0.5b 2014-04-17 Changed to detect collision. (QZN342-3) ' 0.4a 2014-04-17 Added opening. (QZN342-2) ' 0.3a 2014-04-02 Avoided to hold while Turtle moving. (QZN342-1) ' 0.2a 2014-04-02 Changed for Silverlight. (QZN342-0) ' 0.1a 2014-04-02 Created. (QZN342) title = "Turtle Dodger 0.7b" GraphicsWindow.Title = title debug = "False" Init() Opening() Game() Closing() Sub AddObject iMax = obj["iMax"] + 1 obj["iMax"] = iMax GraphicsWindow.PenWidth = 1 type = Math.GetRandomNumber(3) obj[iMax]["type"] = type GraphicsWindow.BrushColor = color[type] sz = size[type] obj[iMax]["obj"] = Shapes.AddRectangle(sz, sz) x = Math.GetRandomNumber(gw - 20) + 10 y = -20 obj[iMax]["x"] = x obj[iMax]["y"] = y Shapes.Move(obj[iMax]["obj"], x, y) Shapes.Rotate(obj[iMax]["obj"], Math.GetRandomNumber(360)) EndSub Sub Closing Timer.Pause() Turtle.Turn(720) GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 40 x = (gw - 217) / 2 y = 100 GraphicsWindow.DrawText(x, y, "GAME OVER") Program.Delay(3000) EndSub Sub Game Turtle.Speed = 7 Turtle.PenUp() x = gw / 2 y = gh - 40 GraphicsWindow.BrushColor = "White" GraphicsWindow.FontSize = 18 score = Shapes.AddText("0") Shapes.Move(score, 20, 20) If debug Then GraphicsWindow.BrushColor = "White" GraphicsWindow.FontSize = 12 pos = Shapes.AddText("(" + x + "," + y + ")") GraphicsWindow.PenWidth = 1 cross1 = Shapes.AddLine(0, -8, 0, 8) cross2 = Shapes.AddLine(-8, 0, 8, 0) Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) Shapes.Move(pos, gw - 100, 20) EndIf Turtle.MoveTo(x, y) Turtle.Angle = 0 Not = "False=True;True=False;" moving = "False" scrolling = "False" Ready() status = LDCommPort.OpenPort("COM3", 115200) LDCommPort.SetEncoding("Ascii") LDCommPort.DataReceived = OnDataReceived tick = "False" Timer.Interval = 1000 / 24 Timer.Tick = OnTick lastems = Clock.ElapsedMilliseconds obj["iMin"] = 1 While Not[cd] If moving Then If key = "A" Then Turtle.TurnLeft() Turtle.Move(30) Turtle.TurnRight() ElseIf key = "B" Then Turtle.TurnRight() Turtle.Move(30) Turtle.TurnLeft() EndIf moving = "False" Else Program.Delay(100) EndIf EndWhile EndSub Sub Init gw = 598 gh = 428 GraphicsWindow.BackgroundColor = "DodgerBlue" GraphicsWindow.Width = gw GraphicsWindow.Height = gh color = "1=Orange;2=Cyan;3=Lime;" size = "1=20;2=16;3=12;" passed = 0 cd = "False" ' collision detected EndSub Sub OnDataReceived If Not[moving] Then dataIn = LDCommPort.RXAll() key = Text.GetSubText(dataIn, 1, 1) If Text.IsSubText("AB", key) Then moving = "True" EndIf EndIf EndSub Sub OnTick If Not[scrolling] Then scrolling = "True" ems = Clock.ElapsedMilliseconds If ems - lastems > 500 Then AddObject() lastems = ems EndIf ScrollObject() scrolling = "False" EndIf If debug Then x = Math.Floor(Turtle.X) y = Math.Floor(Turtle.Y) Shapes.SetText(pos, "(" + x + "," + y + ")") Shapes.Move(cross1, x, y) Shapes.Move(cross2, x, y) EndIf EndSub Sub Opening url = "http://gallery.technet.microsoft.com/Turtle-PNG-Bitmap-for-582b449c/file/116666/1/Turtle.png" bigTurtle = Shapes.AddImage(url) Shapes.Move(bigTurtle, 180, 140) GraphicsWindow.BrushColor = "White" GraphicsWindow.FontName = "Trebuchet MS" GraphicsWindow.FontSize = 50 x = (gw - 443) / 2 y = 40 GraphicsWindow.DrawText(x, y, title) Program.Delay(3000) GraphicsWindow.Clear() EndSub Sub Ready GraphicsWindow.FontSize = 40 rdy = Shapes.AddText("Ready?") x = (gw - 130) / 2 y = 100 Shapes.Move(rdy, x, y) For opacity = 100 To 0 Step -10 Shapes.SetOpacity(rdy, opacity) Program.Delay(200) EndFor Shapes.Remove(rdy) EndSub Sub ScrollObject iMin = obj["iMin"] iMax = obj["iMax"] For i = iMin To iMax x = obj[i]["x"] y = obj[i]["y"] + 5 tx = Math.Floor(Turtle.X) ty = Math.Floor(Turtle.Y) d = Math.SquareRoot(Math.Power(tx - x, 2) + Math.Power(ty - y, 2)) If d < (size[obj[i]["type"]] + 16) / 2 Then cd = "True" ' collision detected Goto break EndIf If y > gh Then passed = passed + 1 Shapes.SetText(score, passed) Shapes.Remove(obj[i]["obj"]) obj[i] = "" obj["iMin"] = i + 1 Else Shapes.Move(obj[i]["obj"], x, y) obj[i]["x"] = x obj[i]["y"] = y EndIf EndFor break: EndSub End>QZN342-6.sb< Start>QZN342.sb< ' Turtle Dodger 0.1a ' Copyright (c) 2014 Nonki Takahashi. ' ' License: ' The MIT License (MIT) ' http://opensource.org/licenses/mit-license.php ' ' History: ' 0.1a 2014-04-02 Created. ' GraphicsWindow.Title = "Turtle Dodger 0.1a" gw = 598 gh = 428 GraphicsWindow.BackgroundColor = "DodgerBlue" GraphicsWindow.Width = gw GraphicsWindow.Height = gh Turtle.Speed = 7 Turtle.PenUp() color = "1=Orange;2=Cyan;3=Lime;" size = "1=20;2=16;3=12;" x = gw / 2 y = gh - 40 Turtle.MoveTo(x, y) Turtle.Angle = 0 Not = "False=True;True=False;" moving = "False" GraphicsWindow.KeyDown = OnKeyDown tick = "False" Timer.Interval = 1000 / 24 Timer.Tick = OnTick lastems = Clock.ElapsedMilliseconds obj["iMin"] = 1 While "True" If tick Then ems = Clock.ElapsedMilliseconds If ems - lastems > 500 Then AddObject() lastems = ems EndIf ScrollObject() tick = "False" EndIf EndWhile Sub OnTick tick = "True" EndSub Sub ScrollObject iMin = obj["iMin"] iMax = obj["iMax"] For i = iMin To iMax x = obj[i]["x"] y = obj[i]["y"] + 5 If y > gh Then Shapes.Remove(obj[i]["obj"]) obj[i] = "" obj["iMin"] = i + 1 Else Shapes.Move(obj[i]["obj"], x, y) obj[i]["x"] = x obj[i]["y"] = y EndIf EndFor EndSub Sub AddObject iMax = obj["iMax"] + 1 obj["iMax"] = iMax GraphicsWindow.PenWidth = 1 type = Math.GetRandomNumber(3) obj[iMax]["type"] = type GraphicsWindow.BrushColor = color[type] sz = size[type] obj[iMax]["obj"] = Shapes.AddRectangle(sz, sz) x = Math.GetRandomNumber(gw - 20) + 10 y = -20 obj[iMax]["x"] = x obj[iMax]["y"] = y Shapes.Move(obj[iMax]["obj"], x, y) Shapes.Rotate(obj[iMax]["obj"], Math.GetRandomNumber(360)) EndSub Sub OnKeyDown If Not[moving] Then moving = "True" key = GraphicsWindow.LastKey If key = "Left" Then Turtle.TurnLeft() Turtle.Move(30) Turtle.TurnRight() ElseIf key = "Right" Then Turtle.TurnRight() Turtle.Move(30) Turtle.TurnLeft() EndIf moving = "False" EndIf EndSub End>QZN342.sb< Start>QZP213.sb< dbg="False" dmt="0=Add/Chng...;1=Diamond;2=MultiDiamnds;3=Lace;4=Spyrall;5=Star5;6=HyperLoop;7=HypFlwrGrid;8=Flwr5;9=Flwr4;10=Clock dmm=11 vcnt=0 deff[1]="{10!S 0!R 108!{5 !R 72!F 80!}!## deff[2]="{5!S 0!{10!R 108!{5 !R 72!F 80!}!}!R 144!U!F 210!D!## deff[3]="{25!S 0!F 30!{3 !R 95!F 140!}!## deff[4]="{95!S 1.025!R 91.5!F 40!## deff[5]="{5!R 144!F 140!## deff[6]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!$!R 90!{55 !R 91.5!F 40!S/1.025!}!&!L 90!{55 !R 91.5!F 40!S/1.025!}!&!R 90!{55 !L 91.5!F 40!S/1.025!}!## deff[7]="{1!L 40!{55 !S 1.025!R 91.5!F 40!}!$!R 90!{55 !R 91.5!F 40!S/1.025!}!&!L 90!{55 !R 91.5!F 40!S/1.025!}!&!R 90!{55 !L 91.5!F 40!S/1.025!}!&!{55 !L 91.5!F 40!S/1.025!}!&!{55 !R 91.5!F 40!S/1.025!}!&!R 180!{55 !R 91.5!F 40!S/1.025!}!&!R 180!{55 !L 91.5!F 40!S/1.025!}!## deff[8]="{5!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.93!}!## deff[9]="{4!|X1=5!|C2=15!{15 !F %2!R |X1!|X1+1.76!}!## deff[10]="{1!D!R 130!{72 !F 11!R 5!}!|V2=1!U!R 140!F 33!L 136!{12 !WRT %1!F 55!R 30!|V2+1!}!R 72!F 20!D!F 100!R 45!F 60!## Init() LDDialogs.AddRightClickMenu(dmt,"") LDDialogs.RightClickMenu=rmm return=0 args=0 GraphicsWindow.MouseDown=mdd GraphicsWindow.MouseMove=mww GraphicsWindow.MouseUp=muu Main() Sub muu nxt=1 endsub Sub cang ox= Turtle.X oy= Turtle.Y nx= GraphicsWindow. Mousex ny= GraphicsWindow. Mousey ta= Turtle.Angle aag= mathplus.GetDegrees ( MathPlus.ATan2(nx-ox,ny-oy)+Math.Pi/2) -ta If aag>180 Then aag=aag-360 elseIf aa<-180 Then aag=aag+360 endif aag=math.Round(aag) endsub Sub mww If rec=1 Then cang() GraphicsWindow.Title = aag+" | old:"+Turtle.angle endif EndSub Sub mdd If mov=1 Then Turtle.x= GraphicsWindow.MouseX Turtle.y=GraphicsWindow.MouseY mov=0 elseif rec=1 and nxt=1 Then nxt=0 'cang() ota=turtle.angle Turtle.Angle=Turtle.Angle+aag If Turtle.Angle>180 then Turtle.Angle=Turtle.Angle-360 elseif Turtle.Angle<-180 then Turtle.Angle=Turtle.Angle+360 endif nta=turtle.angle dta=nta-ota dst= Math.SquareRoot ( ESLMaths.Square (GraphicsWindow.MouseX - Turtle.x)+ESLMaths.Square (GraphicsWindow.Mousey - Turtle.y)) dst=math.Round (dst) Turtle.Move (dst) dd="R " If dta<0 then dd="L " endif 'TextWindow.WriteLine (aag) Clipboard.SetText(cr+dd+Math.Abs(dta)+cr+"F "+dst) LDFocus.SetFocus(pgm) aw = SPExtra.SendKeys("+{INS}") EndIf EndSub Sub findvar ar=Text.ConvertToUpperCase(args[1]) For ax=1 To vcnt If Text.ConvertToUpperCase(mem[ax][0])=ar Then return=ax Goto xxx endif EndFor TextWindow.WriteLine (ar+"VARnotfnd!") return="VARnotfnd!" xxx: endsub Sub rmm dd= LDDialogs.LastRightClickMenuItem if dd>0 Then LDControls .RichTextBoxSetText(pgm, LDText.Replace ( deff[dd],"!",ESLText.CRLF ),"False") Else ib=Dialogs.AskForTextLine ("Name (x=exit, l=load, s=save):","New Menu Item") If ib="s" Then ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("i:\defs.txt",deff) ' The following line could be harmful and has been automatically commented. ' File.WriteContents ("i:\defm.txt",dmt) Dialogs.ShowMessageBox("Saved ok.","Menu","OK","Information") elseIf ib="l" Then ' The following line could be harmful and has been automatically commented. ' deff=File.ReadContents ("i:\defs.txt") ' The following line could be harmful and has been automatically commented. ' dmt=File.ReadContents ("i:\defm.txt") Dialogs.ShowMessageBox("Load ok.","Menu","OK","Information") LDDialogs.AddRightClickMenu(dmt,"") elseIf ib<>"x" then li= LDText.Split (Text.ConvertToUpperCase(src),CR) att="" For t=1 To Array.GetItemCount (li) att=att+li[t]+"!" endfor deff[dmm]= att dmt[dmm]=ib dmm=dmm+1 LDDialogs.AddRightClickMenu(dmt,"") endif EndIf EndSub Sub hshow txx= LDText.Split("FWD!BCK!<<>>!LOOP!VAR!CNST!SUB!FOR!GRID!Rec!MvTo!IF!Wrt!Trac!NEW","!") For x=1 To 16 bb[x]= Controls.AddButton(txx[x], 2, 5+(x-1)*40) EndFor EndSub Sub Main nwwp: nww=0 tree="" tree[1][0]="Main" tree[2][1]="Defs tree[3][2]="Heading tree[4][3]="0 tree[5][2]="Bgrnd tree[6][5]="#bbccdd tree[7][2]="ForeClr tree[8][7]="AUTO tree[9][2]="Width tree[10][9]="4 tree[11][1]="Consts tree[12][1]="Vars tree[13][1]="Subs/Lps mem=0 sbb=0 Goto rr2 rrr: GraphicsWindow.BackgroundColor =bcll rr2: nxt=1 _inn=0 GraphicsWindow.Clear() Turtle.Show() GraphicsWindow.PenWidth=4 Turtle.PenUp () Turtle.MoveTo (600,400) Turtle.PenDown () GraphicsWindow.FontName="Calibri" GraphicsWindow.FontSize=14 hshow() ch=0 _l=1 sc=1 _sbc=0 GraphicsWindow.BrushColor = "DimGray" LDControls.RichTextBoxFontFamily="Lucida Console" LDControls .RichTextBoxFontSize = 18 trr=LDControls.AddTreeView(tree,180,350) nset() Controls.Move (trr,50,gh-355) pgm = ldControls.AddRichTextBox (10, 10) Controls.SetSize(pgm, 180, gh - 360) Controls.Move (pgm,50,1) ldControls.RichTextBoxSetText (pgm, src,"False") LDControls.RichTextBoxDefault(pgm) GraphicsWindow.BrushColor = "Black" g=gh-36 c1= Controls.AddButton("RUN", 2, g) g=g-35 c2=Controls.AddButton("CLR", 2, g) g=g-35 c3=Controls.AddButton("XPlain", 2, g) g=g-35 c4=Controls.AddButton("Paste", 2, g) clicked = "False" Controls.ButtonClicked = OnButtonClicked GraphicsWindow.PenColor = "DimGray" Turtle.Show() Turtle.PenUp() Turtle.MoveTo (700,400) Turtle.PenDown() Turtle.Angle=0 GraphicsWindow.FontName = "Lucida Console" GraphicsWindow.FontSize =12 While "True" If rst=1 Then src = LDControls .RichTextBoxGetText (pgm) tree=LDControls.TreeViewGetData(trr) bcll =tree[6][5] rst=0 If nww=1 then Goto nwwp else Goto rrr endif elseIf clicked Then clicked = "False" src = LDControls .RichTextBoxGetText(pgm) If Text.GetSubText(src,1,1)="{" or Text.GetSubText(src,1,1)="#" then If Text.GetSubText(src,1,1)="#" then dbg="True" Else dbg="False" endif line= LDText.Split (Text.ConvertToUpperCase(src),ESLText.CRLF ) rrw=MathPlus.ToNumber ( text.GetSubTextToEnd(line[1],2)) nLines =Array.GetItemCount (line) If dbg then TextWindow.WriteLine (">>>>>>>>>>>>>>>>>>>>>runn>>>>>>>>>>>>>>>>>>") endif tree=LDControls.TreeViewGetData(trr) 'TextWindow.WriteLine(tree) GraphicsWindow.PenWidth=tree[10][9] 'GraphicsWindow.Title=rrw tree=LDControls.TreeViewGetData(trr) Turtle.Angle =tree[4][3] sbscan() For tt=1 To rrw vcnt=0 'TextWindow.WriteLine (line) For i = 2 To rwx linee=line[i] If Text.StartsWith(linee,"##") then Goto finn else DoLine() endif EndFor finn: EndFor tree[4][3]=math.Round (math.Remainder (Turtle.Angle,360)) LDControls.TreeViewContent(trr,tree) nset() EndIf Else Program.Delay(2) EndIf EndWhile EndSub Sub sbscan c=1 rwx=nLines While Text.StartsWith (line[c],"##")<>"True c=c+1 If c>nLines then TextWindow.WriteLine("No ##") goto tt endif EndWhile rwx=c-1 For i=c To nLines If Text.StartsWith(line[i], "<") Then _sbc=_sbc+1 sbb[_sbc]["Stt"] = i + 1 For k = i+1 To nLines If Text.StartsWith(line[k], ">") Then sbb[_sbc]["End"] = k-1 endif endfor tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 typ="Sb" sbb[_sbc][0]=Text.GetSubTextToEnd (linee, 2) tree[nc][13]=typ+":"+_sbc+">"+sbb[_sbc]["Stt"]+" to "+sbb[_sbc]["End"] LDControls.TreeViewContent(trr,tree) nset() endif endfor tt: Endsub Sub nset LDControls.TreeViewExpand(trr,0,"True","True") nn= LDText.Split("4,6,8,10",",") For x=1 To Array.GetItemCount(nn) LDControls.TreeViewEdit(trr,nn[x],"True") endfor EndSub Sub drwgrd GraphicsWindow.PenWidth=1 GraphicsWindow.PenColor="#aaaaaa For x=1 To 70 GraphicsWindow.DrawLine(220+x*20,0,220+x*20,800) EndFor For x=1 To 40 GraphicsWindow.DrawLine(220,x*20,1400,x*20) EndFor EndSub Sub xplain TextWindow.Show () TextWindow.Clear() idd=" " src = LDControls .RichTextBoxGetText (pgm) TextWindow.WriteLine("Explain program dump list"+ESLText.CRLF ) line= LDText.Split (Text.ConvertToUpperCase(src),ESLText.CRLF ) rrw=MathPlus.ToNumber ( text.GetSubTextToEnd(line[1],2)) nLines =Array.GetItemCount (line) TextWindow.WriteLine ("{Main loop, repeating times:"+rrw) For i=2 To nLines linee=line[i] If Text.StartsWith(linee,"##") then TextWindow.WriteLine ("} Main loop end.*******************") else xpline() endif EndFor endsub Sub OnButtonClicked '"FWD!BCK!<<>>!LOOP!VAR!CNST!sub!FOR!SUB!SAVE!LOAD!IF!HLP!NEW" clb=Controls.LastClickedButton If clb=c2 then rst=1 elseIf clb=c3 then xplain () elseIf clb=c4 then LDControls.RichTextBoxClear (pgm) LDFocus.SetFocus(pgm) aa = SPExtra.SendKeys("+{INS}") rst=1 elseif clb=bb[1] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"F ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[2] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"R180"+cr+"F "+cr+"R180") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[3] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"L ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[4] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"R ") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[5] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"{1 [") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[6] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"|v1=1") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[7] then LDFocus.SetFocus(pgm) Clipboard.SetText("%1") aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[8] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+""+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[9] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"|f1=1"+cr+"{for |f1;10 ["+cr+"]"+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[10] then DrwGrd() elseif clb=bb[11] then rec=1 GraphicsWindow.Title="Recording moves... Hit RB to stop." GraphicsWindow.PenWidth=3 GraphicsWindow.PenColor ="Red elseif clb=bb[12] then mov=1 elseif clb=bb[13] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"{IF \v1 <= 5 ["+cr+"]"+cr+"/else ["+cr+"]"+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[14] then LDFocus.SetFocus(pgm) Clipboard.SetText(cr+"Wrt %1"+cr) aa = SPExtra.SendKeys("+{INS}") elseif clb=bb[15] then GraphicsWindow.FontName="Times New Roman" GraphicsWindow.FontSize=540 GraphicsWindow.FontBold="True GraphicsWindow.FontItalic="True GraphicsWindow.BrushColor="#bbbbbb GraphicsWindow.DrawText(300,150,"F") elseif clb=bb[16] then rst=1 nww=1 src="{1"+cr LDControls.RichTextBoxClear (pgm) LDControls .RichTextBoxSetText (pgm, src,"False") else clicked = "True" endif EndSub Sub DoLine '----------------------------------------------LINEPROC----------------------------- linee= LDText.Trim (linee) If linee="" Or Text.StartsWith(linee,"//") Then Goto exx endif If tree[8][7]="AUTO" Then GraphicsWindow.PenColor=LDColours.HSLtoRGB(math.Remainder (ch,360) ,0.9,0.4) Else GraphicsWindow.PenColor=tree[8][7] endif ch=ch+1 While Text.IsSubText(linee,"%") dorepl() endwhile ree: If Text.StartsWith(linee, Text.GetCharacter (34)) Then 'virtual mode If _inn>0 Then linee=text.GetSubTextToEnd (linee,2) Goto ree Endif elseIf Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then vcnt=vcnt+1 mem[vcnt][1]=vv mem[vcnt][0]=vn elseif dfc="+" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]+vv elseif dfc="~" then rr=ldcall.Function("findvar",vn) mem[rr][1]=vv elseif dfc="*" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]*vv elseif dfc="/" then rr=ldcall.Function("findvar",vn) mem[rr][1]=mem[rr][1]/vv endif ElseIf Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif TextWindow.WriteLine(">:"+ttx) ElseIf Text.StartsWith(linee, "WRT") Then ttx= Text.GetSubTextToEnd (linee,5) If Text.StartsWith (ttx,"|") then vn=text.GetSubText(ttx,2,2) ttx=ldcall.Function("findvar",vn) Endif GraphicsWindow.DrawText(Turtle.x, Turtle.y, ttx) elseif Text.StartsWith(linee, "F") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) 'GraphicsWindow.Title="Dst:"+math.Round ( dist*sc) if dbg then TextWindow.WriteLine(math.Floor (dist*sc)) endif Elseif Text.StartsWith(linee, "S") Then If Text.GetSubText(linee,2,1)="/" then sc=sc/ Text.GetSubTextToEnd(linee, 3) else sc=sc* Text.GetSubTextToEnd(linee, 3) endif If sc=0 then sc=1 EndIf ElseIf Text.StartsWith(linee, "$") Then tx=Turtle.x ty=Turtle.Y ta= Turtle.Angle ts=sc ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) Sst= sbb[scc]["Stt"] sen=sbb[scc]["End"] Stack.PushValue("locali", i) Stack.PushValue("localj", j) For i = sSt To sEn linee=line[i] _inn=_inn+1 DoLine() _inn=_inn-1 Endfor i = Stack.PopValue("locali")+1 j=Stack.PopValue("localj") ElseIf Text.StartsWith(linee, "&") Then Turtle.x=tx Turtle.Y=ty Turtle.Angle=ta sc=ts ElseIf Text.StartsWith(linee, "~H") Then Turtle.x=600 Turtle.Y=400 Turtle.Angle=0 ElseIf Text.StartsWith(linee, "P") Then GraphicsWindow.PenColor=GraphicsWindow.BackgroundColor GraphicsWindow.PenWidth=GraphicsWindow.PenWidth+2 distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Move(math.Floor (dist*sc)) GraphicsWindow.PenWidth=GraphicsWindow.PenWidth-2 ElseIf Text.StartsWith(linee, "~FN") Then GraphicsWindow.FontName=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~FS") Then GraphicsWindow.FontSize=Text.GetSubTextToEnd(Linee,5) ElseIf Text.StartsWith(linee, "~C") Then ccl=GraphicsWindow.BrushColor GraphicsWindow.BrushColor =GraphicsWindow.BackgroundColor GraphicsWindow.FillRectangle (220,200,800,400) GraphicsWindow.BrushColor=ccl ElseIf Text.StartsWith(linee, "~T") Then mem[1][1]=Clock.Hour mem[1][0]="_H" mem[2][1]=Clock.Minute mem[2][0]="_M mem[3][1]=Clock.Second mem[3][0]="_S mem[4][1]=Clock.Date mem[4][0]="_D" ElseIf Text.StartsWith(linee, "~") Then Program.Delay (Text.GetSubTextToEnd(linee, 2)) ElseIf Text.StartsWith(linee, "U") Then Turtle.PenUp() ElseIf Text.StartsWith(linee, "D") Then Turtle.PenDown() ElseIf Text.StartsWith(linee, "R") Then distance = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(dist) ElseIf Text.StartsWith(linee, "L") Then distance = -Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Turn(dist) ElseIf Text.StartsWith(linee, "A") Then distance = -Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(distance,"|") Then rr=ldcall.Function("findvar",vn) dist=mem[rr][1] Else dist=distance endif Turtle.Angle=dist ElseIf Text.StartsWith(linee, ":$") Then icc=Text.GetSubTextToEnd (linee, 3) i=i+icc ElseIf Text.StartsWith(linee, "IF") Then icc=Text.GetSubTextToEnd (linee, 4) vz=text.GetIndexOf(icc,";") sk=text.GetIndexOf(icc," ") v1=text.GetSubText (icc,2,vz-2) v2=ldtext.trim(text.GetSubTexttoend (icc,vz+1)) ss=text.GetIndexOf(v2," ") v2=ESLText.Remove (v2,ss-1,text.GetLength(v2)-ss+1) If sk=0 then skp=2 Else skp=text.GetSubTextToEnd(icc,sk+1) endif cond=0 TextWindow.WriteLine ("Sk:"+Skp) If Text.StartsWith(icc,"=") then If v1=v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,">") then If v1v2 then cond=1 Else cond=2 endif elseIf Text.StartsWith(icc,"!") then If v1<>v2 then cond=1 Else cond=2 endif endif If cond=0 then TextWindow.WriteLine ("IF invalid cond error!") else if cond=1 then 'true part TextWindow.WriteLine ("TRue") Else 'false part TextWindow.WriteLine ("Flss") i=i+skp endif endif ElseIf Text.StartsWith(linee, "{") Then count[_l] = mathplus.ToNumber ( Text.GetSubTextToEnd (linee, 2)) iStart[_l] = i + 1 iEnd[_l] = nLines nest = 0 tree=LDControls.TreeViewGetData(trr) tnd=Array.GetAllIndices(tree) nc=array.GetItemCount (tnd)+1 For k = iStart[_l] To nLines 'TextWindow.WriteLine(">>"+k) If Text.StartsWith(line[k], "{") Then nest = nest + 1 ElseIf Text.StartsWith(line[k], "]") or Text.StartsWith(line[k], "}") Then If nest = 0 Then iEnd[_l] = k - 1 k= nLines Else nest = nest - 1 EndIf EndIf EndFor typ="Lp" tree[nc][13]=typ+":"+nest+">"+iStart[_l]+" to "+iEnd[_l] LDControls.TreeViewContent(trr,tree) nset() j = count[_l] _l = _l + 1 While j>0 Stack.PushValue("local", j) _inn=_inn+1 For i = iStart[_l - 1] To iEnd[_l - 1] linee=line[i] If Text.IsSubText (linee,"%$$") Then linee=TextPlus.ReplaceSubText(linee,"%$$",j) elseIf Text.IsSubText (linee,"%$A") Then linee=TextPlus.ReplaceSubText(linee,"%$A",Turtle.Angle ) elseIf Text.IsSubText (linee,"%$C") Then linee=TextPlus.ReplaceSubText(linee,"%$C",GraphicsWindow.PenColor ) elseIf Text.IsSubText (linee,"%$") Then linee=TextPlus.ReplaceSubText(linee,"%$","%"+j) endif If dbg then TextWindow.WriteLine (i+">>"+linee) endif DoLine() EndFor _inn=_inn-1 j = Stack.PopValue("local")-1 Endwhile _l = _l - 1 i = iEnd[_l] + 2 EndIf exx: EndSub Sub dorepl If Text.IsSubText (linee,"%") Then aq="!! If Text.IsSubText(linee,aq) Then m2=Text.Append("0", mem[2][1]) m2=Text.GetSubTextToEnd (m2,text.GetLength( mem[2][1])) m3=Text.Append("0", mem[3][1]) m3=Text.GetSubTextToEnd (m3,text.GetLength( mem[3][1])) endif If Text.IsSubText (linee,"%1") Then linee=TextPlus.ReplaceSubText(linee,"%1",mem[1][1]) elseIf Text.IsSubText (linee,"%2"+aq) Then linee=TextPlus.ReplaceSubText(linee,"%2"+aq,m2) elseIf Text.IsSubText (linee,"%3"+aq) Then linee=TextPlus.ReplaceSubText(linee,"%3"+aq,m3) elseIf Text.IsSubText (linee,"%2") Then linee=TextPlus.ReplaceSubText(linee,"%2",mem[2][1]) elseIf Text.IsSubText (linee,"%3") Then linee=TextPlus.ReplaceSubText(linee,"%3",mem[3][1]) elseIf Text.IsSubText (linee,"%4") Then linee=TextPlus.ReplaceSubText(linee,"%4",mem[4][1]) elseIf Text.IsSubText (linee,"%5") Then linee=TextPlus.ReplaceSubText(linee,"%5",mem[5][1]) elseIf Text.IsSubText (linee,"%6") Then linee=TextPlus.ReplaceSubText(linee,"%6",mem[6][1]) elseIf Text.IsSubText (linee,"%7") Then linee=TextPlus.ReplaceSubText(linee,"%7",mem[7][1]) elseIf Text.IsSubText (linee,"%8") Then linee=TextPlus.ReplaceSubText(linee,"%8",mem[8][1]) elseIf Text.IsSubText (linee,"%9") Then linee=TextPlus.ReplaceSubText(linee,"%9",mem[9][1]) elseIf Text.IsSubText (linee,"%A") Then linee=TextPlus.ReplaceSubText(linee,"%A",mem[10][1]) elseIf Text.IsSubText (linee,"%B") Then linee=TextPlus.ReplaceSubText(linee,"%B",mem[11][1]) elseIf Text.IsSubText (linee,"%C") Then linee=TextPlus.ReplaceSubText(linee,"%C",mem[12][1]) elseIf Text.IsSubText (linee,"%D") Then linee=TextPlus.ReplaceSubText(linee,"%D",mem[13][1]) elseIf Text.IsSubText (linee,"%E") Then linee=TextPlus.ReplaceSubText(linee,"%E",mem[14][1]) elseIf Text.IsSubText (linee,"%F") Then linee=TextPlus.ReplaceSubText(linee,"%F",mem[15][1]) endif endif endsub Sub fWriteLn TextWindow.WriteLine(idd+args[1]) EndSub Sub xpline '**************************************xplains prg....********************* If Text.StartsWith(linee, "|") Then vn=text.GetSubText(linee,2,2) vv=text.GetSubTextToEnd (linee,5) dfc=text.GetSubText(linee,4,1) If dfc="=" then LDCall.Function("fWriteLn","Define New VAR "+vn+" and assign value:"+vv) vcnt=vcnt+1 mem[vcnt][0]=vn elseif dfc="+" then LDCall.Function("fWriteLn","Increase VAR "+vn+" by:"+vv) elseif dfc="~" then LDCall.Function("fWriteLn","Find VAR "+vn+" and assign value:"+vv) elseif dfc="*" then LDCall.Function("fWriteLn","Multiply VAR "+vn+" by:"+vv) elseif dfc="/" then LDCall.Function("fWriteLn","Divide VAR "+vn+" by:"+vv) endif endif If Text.StartsWith(linee, "W#") Then 'console debug writting ttx= Text.GetSubTextToEnd (linee,3) LDCall.Function("fWriteLn","Write to console:"+ttx) ElseIf Text.StartsWith(linee, "%") then LDCall.Function("fWriteLn","Perform "+Text.GetSubTextToEnd (linee,4)) ElseIf Text.StartsWith(linee, "WRT") Then 'turtle writting ttx= Text.GetSubTextToEnd (linee,5) LDCall.Function("fWriteLn","Write to screen:"+ttx) ElseIf Text.StartsWith(linee, "Ht") Then LDCall.Function("fWriteLn","Reset to Home pos.") elseif Text.StartsWith(linee, "F") Then dist = Text.GetSubTextToEnd(linee, 3) If Text.StartsWith(dist,"%") then dist = "var value:"+mem[ESLMaths.HexToInteger ( mathplus.ToNumber ( Text.GetSubTextToEnd(dist, 2)))][0] endif LDCall.Function("fWriteLn","Forward by:"+ dist) Elseif Text.StartsWith(linee, "<") Then ttx= Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","") Then idd=text.GetSubTextToEnd(idd,3) LDCall.Function("fWriteLn",">END SUB.") Elseif Text.StartsWith(linee, "]") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","] END Repeat block") Elseif Text.StartsWith(linee, "}") Then idd=text.GetSubTextToEnd(idd,4) LDCall.Function("fWriteLn","} END block") Elseif Text.StartsWith(linee, "S") Then If sc=0 then sc=1 LDCall.Function("fWriteLn","Set scale to 1") else If Text.GetSubText(linee,2,1)="%" then LDCall.Function("fWriteLn","Alter scale <(kind +/*) selected by VAR:"+mem[ESLMaths.HexToInteger ( mathplus.ToNumber ( Text.GetSubText(linee, 3,1)))][0]+"> by factor:"+Text.GetSubTextToEnd(linee, 5)) elseIf Text.GetSubText(linee,2,1)="/" then LDCall.Function("fWriteLn","Divide scale by:"+Text.GetSubTextToEnd(linee, 3)) else LDCall.Function("fWriteLn","Multiply scale by:"+Text.GetSubTextToEnd(linee, 3)) endif EndIf ElseIf Text.StartsWith(linee, "$") Then LDCall.Function("fWriteLn","Save turtle pos.") ElseIf Text.StartsWith(linee, "@") Then ' subbs scc=Text.GetSubTextToEnd (linee,2) LDCall.Function("fWriteLn","Call sub:"+sbb[scc][0]) ElseIf Text.StartsWith(linee, "&") Then LDCall.Function("fWriteLn","Restore turtle pos.") ElseIf Text.StartsWith(linee, "U") Then LDCall.Function("fWriteLn","Pen UP - moving") ElseIf Text.StartsWith(linee, "D") Then LDCall.Function("fWriteLn","Pen DN - drawing") ElseIf Text.StartsWith(linee, "R") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn RIGHT by:"+dist) ElseIf Text.StartsWith(linee, "L") Then dist = Text.GetSubTextToEnd(linee, 3) LDCall.Function("fWriteLn","Turn LEFT by:"+dist) ElseIf Text.StartsWith(linee, "{") Then LDCall.Function("fWriteLn","{Repeat block times:"+Text.GetSubTextToEnd(linee,2)) idd=idd+" " EndIf EndSub'---------------------------------xplain********************** Sub Init gw = 1000 gh = 800 GraphicsWindow.Width = gw GraphicsWindow.Height = gh GraphicsWindow.Title = "Turtle Graphics GraphicsWindow.BackgroundColor="#bbccdd GraphicsWindow.Top=0 GraphicsWindow.Left=0 Turtle.Speed=10 CR = ESLText.CRLF src=LDText.Replace ( deff[8],"!",ESLText.CRLF ) EndSub Sub Opening GraphicsWindow.BrushColor = "Black" GraphicsWindow.FontName = "Tahoma" GraphicsWindow.FontSize = 15 GraphicsWindow.PenColor="Black GraphicsWindow.DrawText(310, 30, "S)cale*ff | S/ =S/ff") GraphicsWindow.DrawText(310, 70, "F distance") GraphicsWindow.DrawText(310, 110, "L|R angle") GraphicsWindow.DrawText(310, 150, "D)wn | U)p") GraphicsWindow.DrawText(310, 190, "rpt:{count [cmds]") GraphicsWindow.DrawText(310, 220, "$)save pos.") GraphicsWindow.DrawText(310, 240, "&)load pos.") EndSub End>QZP213.sb< Start>QZP704.sb< GraphicsWindow.BrushColor="darkblue GraphicsWindow.BackgroundColor="teal GraphicsWindow.PenWidth=0 GraphicsWindow.Title="BlockChars GraphicsWindow.Height=900 GraphicsWindow.Width=900 args=0 dy=-50 sc=1 ann="true Sub fss LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) EndSub Sub uss LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) EndSub Sub chadd cc=args[1] If cc="i" then fss()'-------i LDCall.Function4 ("radd" 20 10 90+dx 100+dy) LDCall.Function4 ("cadd" 30 30 100+dx 60+dy) dx=dx+60'------n ElseIf cc="n" then fss() LDCall.Function4 ("radd" 80 10 90+dx 100+dy) dx=dx+60 fss() dx=dx+60'------l ElseIf cc="l" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) dx=dx+60'------o ElseIf cc="o" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 120+dx 180+dy) LDCall.Function4 ("radd" 50 10 120+dx 100+dy) dx=dx+60 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) dx=dx+60'------t ElseIf cc="t" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 40 10 100+dx 180+dy) GraphicsWindow.BrushColor="teal ann="false LDCall.Function4 ("cadd" 40 40 80+dx 40+dy) GraphicsWindow.BrushColor="darkblue LDCall.Function4 ("radd" 20 10 120+dx 100+dy) dx=dx+60'------h ElseIf cc="h" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) LDCall.Function4 ("radd" 70 10 100+dx 100+dy) dx=dx+60 fss() dx=dx+60'------m ElseIf cc="m" then fss() LDCall.Function4 ("radd" 140 10 90+dx 100+dy) dx=dx+60 fss() dx=dx+60 fss() dx=dx+60 ElseIf cc="u" then'----------u uss() LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 uss() dx=dx+60 ElseIf cc="w" then '----------w uss() LDCall.Function4 ("radd" 120 10 120+dx 180+dy) dx=dx+60 uss() dx=dx+60 uss() dx=dx+60 '----y ElseIf cc="y" then uss() LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) dx=dx+60 '----q ElseIf cc="q" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) dx=dx+60'-----j ElseIf cc="j" then LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) LDCall.Function4 ("cadd" 30 30 100+dx 60+dy) dx=dx+60 '----p ElseIf cc="p" then LDCall.Function4 ("radd" 30 130 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) dx=dx+60 ElseIf cc="e" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 70 10 120+dx 180+dy) LDCall.Function4 ("radd" 50 10 120+dx 100+dy) LDCall.Function4 ("radd" 70 10 120+dx 140+dy) dx=dx+60 LDCall.Function4 ("radd" 30 40 100+dx 100+dy) dx=dx+60 '----g ElseIf cc="g" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 40 10 120+dx 100+dy) LDCall.Function4 ("radd" 60 10 120+dx 180+dy) LDCall.Function4 ("radd" 90 10 100+dx 220+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 100+dy) dx=dx+60 '----a ElseIf cc="a" then LDCall.Function4 ("radd" 30 40 100+dx 150+dy) LDCall.Function4 ("radd" 70 10 100+dx 100+dy) LDCall.Function4 ("radd" 70 10 100+dx 140+dy) LDCall.Function4 ("radd" 80 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) dx=dx+60 '----c ElseIf cc="c" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 50 10 120+dx 180+dy) LDCall.Function4 ("radd" 50 10 120+dx 100+dy) dx=dx+90 '----r ElseIf cc="r" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 30 10 130+dx 100+dy) dx=dx+90 '----z ElseIf cc="z" then LDCall.Function4 ("radd" 30 40 100+dx 150+dy) LDCall.Function4 ("radd" 70 10 100+dx 100+dy) LDCall.Function4 ("radd" 70 10 100+dx 140+dy) LDCall.Function4 ("radd" 70 10 120+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 50 100+dx 100+dy) dx=dx+60 '----s ElseIf cc="s" then LDCall.Function4 ("radd" 30 40 100+dx 100+dy) LDCall.Function4 ("radd" 70 10 120+dx 100+dy) LDCall.Function4 ("radd" 70 10 100+dx 140+dy) LDCall.Function4 ("radd" 70 10 100+dx 180+dy) dx=dx+60 LDCall.Function4 ("radd" 30 50 100+dx 140+dy) dx=dx+60 ElseIf cc="b" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 70 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) LDCall.Function4 ("radd" 70 10 100+dx 100+dy) dx=dx+60 LDCall.Function4 ("radd" 30 90 100+dx 100+dy) dx=dx+60'----------v ElseIf cc="v" then LDCall.Function4 ("radd" 50 10 90+dx 100+dy) GraphicsWindow.PenWidth=12 GraphicsWindow.PenColor="darkblue vv=Shapes.AddLine (110+dx 105+dy 140+dx 188+dy) GraphicsWindow.PenWidth=0 LDShapes.AnimateOpacity (vv 1500 3) LDCall.Function4 ("radd" 30 10 135+dx 180+dy) dx=dx+60 uss() dx=dx+60 '------d ElseIf cc="d" then LDCall.Function4 ("radd" 30 90 100+dx 100+dy) LDCall.Function4 ("radd" 80 10 120+dx 180+dy) LDCall.Function4 ("radd" 50 10 120+dx 100+dy) dx=dx+60 LDCall.Function4 ("radd" 30 130 100+dx 60+dy) dx=dx+60 '------k ElseIf cc="k" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 20 10 90+dx 60+dy) LDCall.Function4 ("radd" 90 10 100+dx 140+dy) GraphicsWindow.PenWidth=12 GraphicsWindow.PenColor="darkblue vv=Shapes.AddLine (120+dx 150+dy 175+dx 105+dy) LDShapes.AnimateOpacity (vv 1500 3) GraphicsWindow.PenWidth=0 dx=dx+60 LDCall.Function4 ("radd" 30 40 100+dx 150+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 40 10 90+dx 100+dy) dx=dx+60 '------f ElseIf cc="f" then LDCall.Function4 ("radd" 30 130 100+dx 60+dy) LDCall.Function4 ("radd" 50 10 90+dx 180+dy) LDCall.Function4 ("radd" 50 10 90+dx 100+dy) LDCall.Function4 ("radd" 30 10 120+dx 60+dy) dx=dx+60 Else' --------space and oth. chars If dx>0 then dx=dx+60 endif endif EndSub chr="this typo looks like antique byble guttenberg print bcs of repetitive and uniform char width lorem ipsum dolor sit ament consectutam nonnum unam eiumod just keep on echting zync the quick brown fog jumps over lazy dog For xx=1 to Text.GetLength (chr) LDCall.Function ("chadd" Text.GetSubText(chr xx 1) ) If dx>1900 Then dx=0 dy=dy+180 endif endfor LDEvents.MouseWheel=mww GraphicsWindow.MouseMove =mdd Sub mdd If Mouse.IsLeftButtonDown Then LDGraphicsWindow.Reposition (sc sc ldGraphicsWindow.RepositionedMouseX/sc-100/sc ldGraphicsWindow.RepositionedMouseY/sc-100/sc aa) EndIf EndSub Sub mww If Mouse.IsRightButtonDown Then aa=aa+ LDEvents.LastMouseWheelDelta*3 else sc=sc+ LDEvents.LastMouseWheelDelta/15 EndIf LDGraphicsWindow.Reposition (sc sc 0 0 aa) EndSub Sub radd pp=Shapes.AddRectangle (args[1] args[2]) Shapes.Move (pp args[3] args[4]) LDShapes.AnimateOpacity (pp 1500 3) EndSub Sub cadd pp=Shapes.AddEllipse (args[1] args[2]) Shapes.Move (pp args[3] args[4]) If ann then LDShapes.AnimateOpacity (pp 1500 3) EndIf ann="true EndSub End>QZP704.sb< Start>QZS654.sb< ' recursively sum the digits of a number until there is only one number 'by aabproducoes 'aaugusto444@gmail.com 'facebook.com/antonio.augusto.barbaro GraphicsWindow.CanResize=0 GraphicsWindow.Width=500 GraphicsWindow.Height=400 LDUtilities.ShowErrors="False" GraphicsWindow.Title="Sum Recursively 0.1" 'wallpaper--- back= ImageList.LoadImage("https://st.depositphotos.com/1025323/2214/i/950/depositphotos_22141995-stock-photo-depth-of-mathematics.jpg") wall= Shapes.AddImage(back) Shapes.SetOpacity(wall,50) GraphicsWindow.BackgroundColor="Black" '--- GraphicsWindow.BrushColor="Lime" fn= Controls.AddTextBox(50,50) LDShapes.BrushColour(fn,"Black") Controls.SetSize(fn,200,GraphicsWindow.Height/2-100) Shapes.SetOpacity(fn,50) GraphicsWindow.BrushColor="LightBlue" res= Controls.AddMultiLineTextBox(50, GraphicsWindow.Height/2+50) LDShapes.BrushColour(res,"Black") Controls.SetSize(res,200,GraphicsWindow.Height/2-100) Shapes.SetOpacity(res,50) GraphicsWindow.BrushColor="Lime" GraphicsWindow.FontSize=15 txt[1]= Shapes.AddText("Enter the number:") Shapes.Move(txt[1],50,30) txt[2]= Shapes.AddText("Result:") Shapes.Move(txt[2],50, GraphicsWindow.Height/2+30) GraphicsWindow.BrushColor="Blue" enter= Text.GetCharacter(10)+Text.GetCharacter(13) GraphicsWindow.FontSize=40 gr= Controls.AddButton("S"+enter+"U"+enter+"M",260,50) Controls.SetSize(gr,100, GraphicsWindow.Height-100) Controls.ButtonClicked=bc Sub bc If Controls.LastClickedButton=gr Then nmb= Controls.GetTextBoxText(fn) While nmb>9 sum= 0 For n=1 To Text.GetLength(nmb) sum= sum+Text.GetSubText(nmb,n,1) EndFor nmb=sum EndWhile Controls.SetTextBoxText(res,nmb) EndIf EndSub End>QZS654.sb< Start>QZT806.sb< 'Community Suggestion 2 Draw a flower SetGraphicsWindow() InitScaleAndPosition() DrawGraphic() AddButtons() Controls.ButtonClicked = ButtonClicked Sub SetGraphicsWindow GraphicsWindow.BackgroundColor = "black" GraphicsWindow.PenWidth = 0 w = 600 h = 400 GraphicsWindow.Width = w GraphicsWindow.Height = h txt = Shapes.AddText("Chrysanthemum") Shapes.Zoom(txt, 1.5,1.5) Shapes.Move(txt, 30, 10) EndSub Sub InitScaleAndPosition s = 1 'scale x = 0 'move 0 to centre for x & y y = 0 EndSub Sub DrawGraphic a = 70*s b = 20*s c = 200*s d = 0 'init rotate angle GraphicsWindow.BrushColor = "white" For i = 2 To 20 ellipse[i] = Shapes.AddEllipse(b,c) Shapes.Move(ellipse[i], ((w/2)-(b/2))+x, ((h/2)-(c/2))+y) EndFor GraphicsWindow.BrushColor = "yellow" ellipse[1] = Shapes.AddEllipse(a,a) Shapes.Move(ellipse[1], ((w/2)-(a/2))+x, ((h/2)-(a/2))+y) For i = 3 To 21 Step 2 Shapes.SetOpacity(ellipse[i], 90) EndFor For i = 2 To 20 Shapes.Rotate(ellipse[i], d) d = d + 10 EndFor EndSub Sub AddButtons GraphicsWindow.BrushColor = "purple" caption = "1=Exit;2=Modify All;3=Scale Down;4=Scale Up" For i = 1 to 4 button[i] = Controls.AddButton(caption[i], w-(95*i), 5) Controls.SetSize(button[i], 90, 25) EndFor EndSub Sub ButtonClicked Shapes.HideShape(zoomTxt) Sound.PlayClickAndWait() If Controls.LastClickedButton = button[1] Then GraphicsWindow.Clear() GraphicsWindow.BrushColor = "cyan" bye = Shapes.AddText("Goodbye") Shapes.Zoom(bye, 2,2) Shapes.Move(bye, 5, h/2) z = 1 While z < 610 Shapes.Move(bye, z, h/2) z = z + 0.05 Program.Delay(0.0001) If z = 610 Then Program.End() EndIf EndWhile ElseIf Controls.LastClickedButton = button[2] Then Sound.PlayChimesAndWait() GraphicsWindow.BrushColor = "cyan" oops = Shapes.AddText("Oops..Feature Coming Soon") Shapes.Move(oops, w/2-100, h/2) For i = 1 To 50 Shapes.Zoom(oops, i/15, i/15) Shapes.SetOpacity(oops, i*2) Program.Delay(10) EndFor Program.Delay(2000) Shapes.HideShape(oops) ElseIf Controls.LastClickedButton = button[3] Then If s > 0.1 Then s = s - 0.1 Zoom() Else ZoomMessage() ' Message is cleared at start of ButtonClicked EndIf ElseIf Controls.LastClickedButton = button[4] Then If s < 2 Then s = s + 0.1 zoom() Else ZoomMessage() EndIf EndIf EndSub Sub ZoomMessage zoomTxt = Shapes.AddText("Scale Limit Reached") Shapes.Move(zoomTxt, w-(95*3.5), 5+30) Sound.PlayBellRing() EndSub Sub Zoom ' <---------------- add For i = 1 To 20 Shapes.zoom(ellipse[i], s,s) 'TextWindow.WriteLine("s = " +s) CHECKING EndFor EndSub End>QZT806.sb< Start>QZV707.sb< GraphicsWindow.BackgroundColor ="darkblue GraphicsWindow.BrushColor="gold GraphicsWindow.FontSize=16 GraphicsWindow.FontBold="false GraphicsWindow.FontName="Noto mono GraphicsWindow.Title="Old PC Demo not="true=false;false=true tw=Controls.AddMultiLineTextBox(350 5) nn=text.GetCharacter(13)+ Text.GetCharacter(10) drr="C:\>" bst=0 off="true Controls.SetTextBoxText(tw "") LDShapes.BrushColour(tw, "darkblue") Controls.SetSize(tw 500 500) GraphicsWindow.Width=860 GraphicsWindow.Height=800 GraphicsWindow.Left=5 GraphicsWindow.Top=5 GraphicsWindow.BrushColor="#C7B8B3 GraphicsWindow.PenWidth=0 Shapes.AddRectangle(340 600) GraphicsWindow.PenWidth=0.6 ox=-150 oy=-122 inits() For r=1 To Array.GetItemCount(shape) LDCall.Function("drwws" shape[r]) EndFor GraphicsWindow.KeyDown=kkd LDShapes.SetShapeEvent(ssh[4]) LDShapes.SetShapeEvent(ssh[17]) LDShapes.SetShapeEvent(ssh[18]) LDEffect.DropShadow(ssh[4] "direction=175;") GraphicsWindow.FontName="LCD" GraphicsWindow.FontSize=33 tt=133 LDShapes.ShapeEvent=see uu[1]=Shapes.AddText("_") uu[2]=Shapes.AddText("_") uu[3]=Shapes.AddText("_") For i=1 To 3 Shapes.Move(uu[i] i*20+10,265) LDShapes.ZIndex(uu[i] 4-i) LDShapes.PenColour(uu[i] "lime") LDShapes.brushColour(uu[i] "black") EndFor GraphicsWindow.FontName="times new roman GraphicsWindow.FontSize=17 GraphicsWindow.BrushColor="black mh=Shapes.AddText("MHz") Shapes.Move(mh 99 280) mh=Shapes.AddText("I/O") ldShapes.Centre(mh 260 210) mh=Shapes.AddText("Turbo") ldShapes.Centre(mh 190 270) mh=Shapes.AddText("Reset") ldShapes.Centre(mh 240 270) mh=Shapes.AddText("HDD") ldShapes.Centre(mh 290 270) 'txset() args=0 Timer.Interval=330 Timer.Tick=ttt While 1=1 If btt Then btt="false If off Then Goto xxx Else Controls.SetTextBoxText(tw "AMI Bios V1.25") ldcall.function("dly" 1555) EndIf If off Then Goto xxx Else Controls.SetTextBoxText(tw "AMI Bios V1.25"+nn+nn+"Detecting drives...") ldcall.function("dly" 2555) EndIf If off Then Goto xxx Else Controls.SetTextBoxText(tw "AMI Bios V1.25"+nn+nn+"Detecting drives..."+nn+"A: FDD 1.2Mb"+nn+"B: FDD 1.44Mb") ldcall.function("dly" 1555) EndIf If off Then Goto xxx Else Controls.SetTextBoxText(tw "AMI Bios V1.25"+nn+nn+"Detecting drives..."+nn+"A: FDD 1.2Mb"+nn+"B: FDD 1.44Mb"+nn+"HDD 160Mb") ldcall.function("dly" 3555) EndIf If off Then Goto xxx Else Controls.SetTextBoxText(tw "Pseudo-DOS V5.00"+nn+"Type Hlp for help"+nn+nn+drr) EndIf xxx: ElseIf lkk="Escape" Then lkk="nix" ttx=Controls.GetTextBoxText(tw) ta=LDText.Split(ttx nn) ll=Array.GetItemCount(ta) lw=Text.GetLength(ta[ll]) lln=Text.ConvertToLowerCase(ta[ll]) If Text.GetSubTextToEnd(lln lw-1)="nc" Then Controls.SetTextBoxText(tw ttx+nn) txset() ElseIf Text.GetSubTextToEnd(lln lw-1)="a:" Then drr="A:\>" Controls.SetTextBoxText(tw ttx+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-1)="b:" Then drr="B:\>" Controls.SetTextBoxText(tw ttx+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-1)="c:" Then drr="C:\>" Controls.SetTextBoxText(tw ttx+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-1)="d:" Then drr="D:\>" Controls.SetTextBoxText(tw ttx+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy d a" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[8] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[13] 350 12) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"2 Files copied."+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy d b" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[8] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[16] 350 12) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"2 Files copied."+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy d c" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[8] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[19] 350 10) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"4 Files copied."+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy c a" or Text.GetSubTextToEnd(lln lw-7)="copy a c" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[13] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[19] 350 10) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"2 Files copied."+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy c b" or Text.GetSubTextToEnd(lln lw-7)="copy b c" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[16] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[19] 350 10) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"3 Files copied."+nn+drr) ElseIf Text.GetSubTextToEnd(lln lw-7)="copy b a" or Text.GetSubTextToEnd(lln lw-7)="copy a b" Then Controls.SetTextBoxText(tw ttx+nn+"Copying...") LDShapes.AnimateOpacity(ssh[16] 250 10) Program.Delay(155) LDShapes.AnimateOpacity(ssh[13] 350 12) Program.Delay(3000) Controls.SetTextBoxText(tw ttx+nn+"1 File copied."+nn+drr) EndIf EndIf Program.Delay(55) EndWhile '===========================------subs---------------- Sub dly If trb Then p10=5 Else p10=10 EndIf pp=Math.Floor(args[1]/10)*p10 For xx=1 To pp/10 Program.Delay(2) If off Then Goto xxf EndIf EndFor xxf: EndSub Sub see ls=LDShapes.LastEventShape lt=LDShapes.LastEventType If lt="MouseDown" Then If ls=ssh[4] Then bst=1-bst If bst=1 Then off="false btt="true LDEffect.Clear(ls) settrb() LDShapes.BrushColour(ssh[20] "yellow") Else For i=1 To 3 Shapes.SetText(uu[i] "_") EndFor Controls.SetTextBoxText(tw "") off="true LDEffect.DropShadow(ls "direction=175;") LDShapes.BrushColour(ssh[20] "darkgreen") EndIf ElseIf ls=ssh[18] Then LDEffect.Clear(ls) rst="true Controls.SetTextBoxText(tw "") off="true ElseIf ls=ssh[17] and not [off] Then tt=299-tt settrb() ElseIf ls=ssh[17] Then tt=299-tt If tt=166 Then LDEffect.Clear(ls) Else LDEffect.DropShadow(ls "direction=175;") EndIf EndIf ElseIf lt="MouseUp" and rst Then rst="false off="false Controls.SetTextBoxText(tw "") If bst>0 Then btt="true EndIf LDEffect.DropShadow(ssh[18] "direction=175;") EndIf If tt=166 Then trb="true Else trb="false EndIf EndSub Sub settrb For i=1 To 3 Shapes.SetText(uu[i] Text.GetSubText(tt i 1)) EndFor If tt=166 Then LDEffect.Clear(ls) Else LDEffect.DropShadow(ls "direction=175;") EndIf EndSub Sub kkd lkk=GraphicsWindow.LastKey GraphicsWindow.Title=lkk EndSub Sub inits shape[12]="dsc=FDD head lock;fn=Pol;x=237;y=247;pts=3.2,4 16.0,4 16.0,64 3.2,64;zmw=1;zmh=1;ang=0;op=100;bc=#888888;pc=#1E50A2;pw=1;" shape[2]="dsc=CD Unit;fn=Pol;x=178;y=159;pts=4,6.0 279,6.0 279,81.0 4,81.0;zmw=1;zmh=1;ang=0;op=60.0;bc=#BED3CA;pc=#1E50A2;pw=1.5;" shape[3]="fn=Pol;x=240;y=252;pts=0,0.0 100,0.0 100,60.0 0,60.0;zmw=1;zmh=1;ang=0;op=65.00;bc=#777777;pc=#1E50A2;pw=1.2;" shape[4]="dsc=Power Switch;fn=Pol;x=379;y=346;pts=31.5,35.0 41.22,34.15 50.04,31.65 56.97,27.80 61.47,22.90 63.0,17.5 61.47,12.10 56.97,7.20 50.04,3.35 41.22,0.85 31.5,0.0 21.78,0.85 12.96,3.35 6.03,7.20 1.53,12.10 0.0,17.5 1.53,22.90 6.03,27.80 12.96,31.65 21.78,34.15;zmw=1;zmh=1;ang=0;op=100;bc=white;pc=#1E50A2;pw=0.5;" shape[5]="dsc=CD audio-out 3,5mm;fn=Pol;x=207;y=221;pts=7.0,14.0 9.16,13.66 11.12,12.66 12.66,11.12 13.66,9.16 14.0,7.0 13.66,4.84 12.66,2.88 11.12,1.34 9.16,0.34 7.0,0.0 4.84,0.34 2.88,1.34 1.34,2.88 0.34,4.84 0.0,7.0 0.34,9.16 1.34,11.12 2.88,12.66 4.84,13.66;zmw=1;zmh=1;ang=0;op=100;bc=darkgray;pc=#1E50A2;pw=0.2;" shape[6]="dsc=CD tray;fn=Pol;x=194;y=171;pts=4,4 244,4 244,33 4,34;zmw=1;zmh=1;ang=0;op=100;bc=lightgray;pc=#1E50A2;pw=1;" shape[7]="dsc=CD volume control;fn=Pol;x=235;y=218;pts=4,4 24,4 24,14 4,14;zmw=1;zmh=1;ang=0;op=100;bc=#BED3CA;pc=#1E50A2;pw=1;" shape[9]="dsc=CD eject/load;fn=Pol;x=400;y=218;pts=4,4 27,4 27,14 4,14;zmw=1;zmh=1;ang=0;op=100;bc=#BED3CA;pc=#1E50A2;pw=1;" shape[14]="dsc=FDD 3.5' Unit;fn=Pol;x=178;y=320;pts=4,6.0 185,6.0 185,51.0 4,51.0;zmw=1;zmh=1;ang=0;op=60.0;bc=#999999;pc=#1E50A2;pw=1.5;" shape[1]="dsc=FDD 5.25' Unit;fn=Pol;x=178;y=239;pts=4,6.0 279,6.0 279,81.0 4,81.0;zmw=1;zmh=1;ang=0;op=60.0;bc=#999999;pc=#1E50A2;pw=1.5;" shape[15]="dsc=FDD tray;fn=Pol;x=188;y=332;pts=4,4 167,4 167,12 4,12;zmw=1;zmh=1;ang=0;op=100;bc=green;pc=#1E50A2;pw=1;" shape[11]="dsc=FDD tray;fn=Pol;x=194;y=272;pts=4,4 244,4 244,12 4,12;zmw=1;zmh=1;ang=0;op=100;bc=green;pc=#1E50A2;pw=1;" shape[10]="fn=Pol;x=300;y=252;pts=0,0 40,0 40,60.0 0,60.0;zmw=1;zmh=1;ang=0;op=65.00;bc=#666666;pc=#1E50A2;pw=1.2;" shape[13]="dsc=FDD in use;fn=Pol;x=404;y=252;pts=7.0,14.0 9.16,13.66 11.12,12.66 12.66,11.12 13.66,9.16 14.0,7.0 13.66,4.84 12.66,2.88 11.12,1.34 9.16,0.34 7.0,0.0 4.84,0.34 2.88,1.34 1.34,2.88 0.34,4.84 0.0,7.0 0.34,9.16 1.34,11.12 2.88,12.66 4.84,13.66;zmw=1;zmh=1;ang=0;op=100;bc=#FFCD853F;pc=#1E50A2;pw=0.2; shape[8]="dsc=CD in use;fn=Pol;x=264;y=218;pts=4,4 18,4 18,14 4,14;zmw=1;zmh=1;ang=0;op=100;bc=darkgreen;pc=#1E50A2;pw=1;" shape[16]="dsc=FDD in use;fn=Pol;x=230;y=354;pts=4,4 18,4 18,10 4,10;zmw=1;zmh=1;ang=0;op=100;bc=darkgreen;pc=#1E50A2;pw=1;" shape[19]="dsc=HDD in use;fn=Pol;x=430;y=411;pts=4,4 18,4 18,10 4,10;zmw=1;zmh=1;ang=0;op=100;bc=darkred;pc=#1E50A2;pw=1;" shape[20]="dsc=Pwr Led;fn=Pol;x=430;y=422;pts=4,4 18,4 18,10 4,10;zmw=1;zmh=1;ang=0;op=100;bc=darkgreen;pc=#1E50A2;pw=1;" shape[17]="dsc=Turbo Sw;fn=Ell;x=330;y=414;w=40;h=20;zmw=1;zmh=1;ang=45;op=100;bc=darkred;pc=#1E50A2;pw=1;" shape[18]="dsc=Reset;fn=Ell;x=380;y=414;w=40;h=20;zmw=1;zmh=1;ang=45;op=100;bc=darkgreen;pc=#1E50A2;pw=1;" EndSub Sub drwws ag=text.ConvertToLowerCase( args[1]) If ag["fn"]="ell" Then shp=Shapes.AddEllipse(ag["w"] ag["h"]) Shapes.Move(shp ag["x"]+ox oy+ag["y"] ) Shapes.Rotate(shp ag["ang"]) LDDialogs.ToolTip(shp args[1]["dsc"]) LDEffect.DropShadow(shp "direction=175;") ElseIf ag["fn"]="pol" Then i=0 po="" ps=ag["pts"] ps=LDText.Replace(ps "," " ") pp=LDText.Split(ps " ") For x=1 To Array.GetItemCount(pp)-1 Step 2 i=i+1 po[i][1]=pp[x]+ox po[i][2]=pp[x+1]+oy EndFor shp = Ldshapes.AddPolygon(po) LDShapes.BrushColour(shp ag["bc"]) Shapes.Move(shp ag["x"] ag["y"]) LDDialogs.ToolTip(shp args[1]["dsc"]) EndIf ssh[r]=shp 'LDEffect.DropShadow(shp "direction=155;color=#009999") 'LDShapes.AnimateOpacity(shp 666 4) EndSub Sub txset TextWindow.Left=1100 rdr="true ' The following line could be harmful and has been automatically commented. ' st=File.GetDirectories("e:\sndbx") ' The following line could be harmful and has been automatically commented. ' fl=File.GetFiles("e:\sndbx") dd=Array.GetItemCount(st) d1=Array.GetItemCount(fl) For r=1 To d1 st[r]="!>"+text.ConvertToUpperCase(Text.GetSubTextToEnd(st[r] 4)) EndFor For r=1 To d1 ' The following line could be harmful and has been automatically commented. ' st[ dd+r]= text.GetSubText( LDFile.GetExtension( fl[r])+" " 1 3)+text.GetSubText( LDfile.GetFile( fl[r])+" " 1 25)+"|"+text.GetSubText( LDFile.GetExtension( fl[r])+" " 1 3)+"|"+LDFile.Size(fl[r]) EndFor qq=LDArray.CreateFromValues(st) LDArray.Sort(qq) st=LDArray.CopyToSBArray(qq) For f=1 To Array.GetItemCount(st) If Text.StartsWith(st[f] "!>") Then Else st[f]=Text.GetSubTextToEnd(st[f] 4) EndIf EndFor mk=30 lsl=1 cll=5 ii=1 jj=mk ldTextWindow.KeyDown=kkk 'LDEvents.MouseWheel=mww While 1=1 If rdr Then drww() rdr="false EndIf EndWhile EndSub Sub kkk lk= LDTextWindow.LastKey If lk="Up" Then lsl=lsl-1 If lsl<0 Then lsl=0 ii=ii-1 jj=jj-1 EndIf ElseIf lk="Return" Then GraphicsWindow.Title=st[lsl+ii] ElseIf lk="Down" Then lsl=lsl+1 If lsl>mk-1 Then lsl=mk-1 ii=ii+1 jj=jj+1 EndIf EndIf rdr="true TextWindow.Title=lk EndSub Sub drww TextWindow.CursorLeft=cll TextWindow.CursorTop=3 mm=40 TextWindow.ForegroundColor="cyan" ln=Text.GetSubText("╔════════════════════════════════════════════════" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.WriteLine(ln+"╗") For f=ii To jj TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.Write("║ ") If f-ii=lsl Then TextWindow.BackgroundColor="yellow" textWindow.ForegroundColor="black" Else TextWindow.ForegroundColor="cyan" EndIf TextWindow.Write(Text.GetSubText(ldtext.Replace( st[f] "_" " ")+" " 1 mm)) TextWindow.BackgroundColor="blue" TextWindow.ForegroundColor="cyan" TextWindow.Write(" ║") TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") EndFor TextWindow.BackgroundColor="blue" ln=Text.GetSubText("╟────────────────────────────────────────────────" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.Write(ln+"╢") TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") TextWindow.BackgroundColor="blue" TextWindow.CursorLeft=cll ln=Text.GetSubText((lsl+ii)+"/"+Array.GetItemCount(st)+" " 1 mm)+" ║" TextWindow.Write("║ "+ln) TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") ln=Text.GetSubText("╚════════════════════════════════════════════════" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.BackgroundColor="blue" TextWindow.Write(ln+"╝") TextWindow.BackgroundColor="black" TextWindow.WriteLine("▒") ln=Text.GetSubText("▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒" 1 mm+3) TextWindow.CursorLeft=cll TextWindow.WriteLine(" "+ln) EndSub Sub ttt If Math.GetRandomNumber(5)>3 and bst=1 Then LDShapes.BrushColour(ssh[19] "red") Else LDShapes.BrushColour(ssh[19] "darkred") EndIf EndSub End>QZV707.sb< Start>QZZ154.sb< 'Small Basic curriculum 'Lesson 1.5 Branching and Subroutines 'Write a program that opens a text window and then performs the following steps: '1.Asks the user for the name, temperature, rain status, and wind status of 10 cities. '2.Uses branching and subroutines to determine and display the total number of: 'Cold Cities, Cool Cities, Warm Cities, Hot Cities, Rainy Cities, Windy Cities. 'asks the user for city name, temp and weather inputs While c < 10 TextWindow.WriteLine("City Name Please: ") cityname = TextWindow.Read() TextWindow.WriteLine("City Temperature Please: cool, cold, warm or hot? ") citytemp = TextWindow.Read() TextWindow.WriteLine("City climate pls: windy or rainy ") Windorrain = TextWindow.Read() count_windy_or_rainy() TextWindow.WriteLine("") TextWindow.WriteLine("now for the next city") TextWindow.WriteLine("") 'call subroutines to count temps and weather count_citytemp() count_windy_or_rainy() c=c+1 EndWhile 'to display the final count of each type of city If c = 10 then TextWindow.WriteLine("Thank you") TextWindow.WriteLine("There are " + countcool + " cool cities.") TextWindow.WriteLine("There are " + countcold + " cold cities.") TextWindow.WriteLine("There are " + countwarm + " warm cities.") TextWindow.WriteLine("There are " + counthot + " hot cities.") TextWindow.WriteLine("There are " + countrainy + " rainy cities.") TextWindow.WriteLine("And last but by no means least...There are " + countwindy + " windy cities") endif 'subroutine to count the number of windy or rainy cities Sub count_windy_or_rainy if Windorrain = "rainy" then countrainy = countrainy + 1 ElseIf Windorrain = "windy" then countwindy = countwindy + 1 EndIf EndSub 'subroutine to count the number of cool, cold, warm hot cities sub count_citytemp If citytemp = "cool" Then countcool = countcool + 1 ElseIf citytemp = "cold" then countcold = countcold + 1 elseif citytemp = "warm" then countwarm = countwarm +1 Else counthot = counthot +1 EndIf EndSub End>QZZ154.sb< Start>QZZ849.sb< GraphicsWindow.Show() GraphicsWindow.BackgroundColor="teal dw=desktop.Width dh=desktop.Height GraphicsWindow.width=dw GraphicsWindow.Height=dh GraphicsWindow.Top=0 GraphicsWindow.Left=0 view3D = LD3DView.AddView(dw,dh,"True") 'Will not clip to size if window rescaled 'Some different light types LD3DView.AddDirectionalLight(view3D,"white",1,1,1) LD3DView.AddAmbientLight(view3D,"#88aabbcc") LD3DView.AutoControl ("true" "true",-1,3) 'Initial camera position and direction and view angle LD3DView.ResetCamera(view3D,-30,15,30, 5, 0, -3, "","","") r=.2 pp="1 0 For y=1 To 18 Step .5 If y>10 then r=r*1.2 endif pp=text.Append(pp y+" ") pp=text.Append(pp r+" ") EndFor For y=18 To 12 Step -0.5 pp=text.Append(pp y+" ") pp=text.Append(pp r+" ") r=r/1.25 EndFor pp=text.Append(pp y+1) pp=text.Append(pp " 0") ob1= LD3DView.AddRevolute (view3D pp 30 "#888888" "D") For x= 3 To 0.5 Step -.5 LD3DView.AnimateRotation (view3d,ob1,1 1 1,0 360 x, 1) Program.Delay (x*1000) EndFor LD3DView.AnimateRotation (view3d,ob1,1 1 1,0 360 .3, -1) End>QZZ849.sb< Start>QZZ877.sb< ' Challenge of the Month - May 2012 Cannon ball Distance and Height by NaochanON ' init() V=100 ' m/s g= 10 ' m/s/s. For deg=5 To 90 ball[deg]= Shapes.AddEllipse(20,10) Shapes.Move(ball[deg],0,-100) Shapes.Rotate(cannon,-deg) Shapes.move(cannon,-25*Math.cos(rad),600-25*Math.sin(rad)) rad= Math.GetRadians(deg) t=0 y=0.01 While 0QZZ877.sb<