PritchBASIC 2015 - Successor to FreeBASIC with Embedded IDE

For other topics related to the FreeBASIC project or its community.
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

PritchBASIC 2015 - Successor to FreeBASIC with Embedded IDE

Postby Pritchard » Apr 01, 2015 15:18

New to create new files.

Help for command list.

Compile to compile and execute.

Enjoy!

Code: Select all

' Original:  http://freebasic.net/forum/viewtopic.php?t=7888&p=67178
' Archived by the internet archive.  Retrieved latest on Jan 27, 2015.
' Welcome to the PritchBASIC Compiler!

' WELCOME TO THE 2015 EDITION:  FreeBeerSIC

NameSpace Trivia
 
    ''  A type for just ONE QUESTION
  Type Question
    Q                 As ZString Ptr
    A                 As ZString ptr
    RA                As ZString Ptr
    WA                As ZString ptr
  End Type
 
    '' Holds a list of questions, aka:  A trivia
  Type QuestionList
   
      '' How many questions we've made so far
    NumQ              As Integer = 0
   
      '' Our question list
    Q                 As Question ptr ptr
         
      '' Ask just one question
    Declare Function AskQuestion( ByVal Index as Integer ) as Integer
   
      '' Make a new question.  Question, Answer, What to say if they got it right, what to say if they got it wrong
    Declare Sub NewQuestion( ByVal QuestionVal as ZString ptr, ByVal AnswerVal as ZString ptr, _
                             ByVal ResponseIfRight as ZString Ptr, ByVal ResponseIfWrong as Zstring ptr)
   
      '' Cleans up memory for us
    Declare Destructor
  End Type
 
End Namespace
 
Declare Function Main( ByVal QList as Trivia.Questionlist ptr ) as integer
 
  '' Create a new Trivia pointer for us to use!
Dim QuestionList as Trivia.QuestionList ptr = New Trivia.QuestionList
 
  '' Make a funny list of questions XD
QuestionList->NewQuestion( "Please Enter in a Command", "", "", "" )
QuestionList->NewQuestion( "Is this Okay? Y/N", "Y", !"^_^;; I am glad you are pleased with this program.  PritchBASIC's goals lie only in making you happier.  You may in fact wish to buy our PREMIUM COMPILER PACKAGE, which will definitely be at a bargain for a loyal customer such as yourself :D \n", !"I am sorry, but that feature is not available in your vesion of PritchBASIC.  You may wish to buy the Premium BASIC compiler for only $5995,959.55, as it contains this feature.  I recommend it . . . \n" )
 
Screenres 640, 480, , , 1
 
Print "Welcome to the PritchBASIC IDE.  We here at PritchBASIC hope you enjoy using our compiler."
Print "Note:  You do not appear to have the premium package."
Print "Most features are not available until you buy the premium package"
Print "For only $5995.95, you can get the PremiumBASIC Package for PritchBASIC"
Print " . . . Just my recommendation"
Print
Print
Print !"Type \"help\" to get a command-list.  Type \"new\" to make a new program. Type \"compile\" to compile your program"
Print
Print
 
Do
  if ( Main( QuestionList ) <> 0) then exit do
Loop
 
do
  Print "APRIL FOOLS!"
loop until multikey(&h01)
 
  '' Ask all of the questions we've loaded above
  '' Clear up all our memory
Delete QuestionList
 
Function Main( ByVal Qlist as Trivia.QuestionList ptr ) as integer
 
  while inkey <> "": Wend
  if (Qlist->AskQuestion(0) = -10) then return -1
  If ( QList->AskQuestion(1) <> 0 ) then
    Print *QList->Q[1]->RA
  else
    Print  *Qlist->Q[1]->WA
  End if
  sleep
  cls
 
End function
 
 
NameSpace Trivia
     
  Destructor QuestionList
 
      '' Delete all the questions
    For DoVar as Integer = 0 to This.NumQ - 1
     
        '' Delete the Text in the questions
      Deallocate This.Q[DoVar]->Q
      Deallocate This.Q[DoVar]->A
      Deallocate This.Q[DoVar]->RA
      Deallocate This.Q[DoVar]->WA
     
        '' Delete the question itself
      Delete This.Q[DoVar]
     
    Next
   
      '' Delete the question list
    Deallocate This.Q
 
  End Destructor
   
  Function QuestionList.AskQuestion( ByVal Index as Integer ) as Integer
   
      '' Hold the answer that's being input
    Dim as String Answer
   
      '' Print the question
    Print *This.Q[Index]->Q
   
      '' Let the user give a guess at the answer
    Input Answer
   
      '' If the what they typed matched what we have then they got it right :D
    If ucase(Answer) = ucase( *This.Q[Index]->A ) then
      Return -1
    else
     
      Select Case Ucase(Answer)
      case "FINAL FANTASY", "APRIL", "FOOLS", "APRIL FOOLS", "JOKE", "PREMIUMBASIC", "PRITCHBASIC", "PRITCHARD", "PB", "POWERBASIC", "PIZZA", "COOKIE", "BUNNY", "PIRATE", "MOOGLE"
        sleep
        return -10
      case "COMPILE"
        Print !"Now compiling!"
        Print !"By the way, did you know that with PritchBASIC Premium \n WHICH IS ONLY $5995.95 BTW!, you can \n have your programs optimized for you phenominally!  BUY IT TODAY!  \n \n I'm just trying to be a good friend, my good man! \n"
        Open "PritchBASIC_OUT.bas" for Output as #1
          Print #1, "Do"
          Print #1, !"Print \"APRIL FOOLS!!!\""
          Print #1, "Loop until multikey(&h01)"
        Close #1
        shell "fbc PritchBASIC_OUT.bas"
      case "HELP"
        Print
        Print !"Command List: \n \n Case \n Compile \n Do \n Help \n Include \n Loop \n New \n Until \n Quit"
        Print !"\n CHUCKNORRIS \n HELLOTHAR \n OMG \n OMGUNOWAT? \n KTHX \n KTHXBAI \n KTHXDAINOWPLZ \n IFAreThisNotRight \n RlyBigNumberWithNoDecimalPlaces"
        Print !"\n CHA0SISAWESOME \n LILLO \n RELSOFT \n DR_D \n LACHIE \n LITHIUM \n ZAMASTER \n DRV \n V1CTOR (the best command) \n KEYLOGGER"
        PRINT !"\n SPAM \n LIKETTLY \n OVERRIDECOMPUTER \n OPEN \n FUN \n LINE \n IDIOT \n REMARKABLE \n PRINT \n AWESOME [...]"
        Print
        Print !"You do not appear to have the Premium help package file for PritchBASIC"
        Print !"Without the premium help file package (which is only $599! Can you believe it?! Of course, it's only a small piece of trash when compared to the PritchBASIC PremiumBASIC Package!)"
        Print !"You can not get full help on all commands, nor get a full command list \n There may even be commands IN YOUR VERSION RIGHT NOW \n THAT I CAN NOT EVEN TELL YOU ABOUT \n BECAUSE YOU HAVEN'T BOUGHT THE PREMIUM PACKAGE!!!"
      Case "LINE"
        Print !"I'm sorry, but this command is only available in the PremiumBASIC package \n for PritchBASIC! \n Do not fret though!  The PremiumBASIC Package only costs \n \n $5995.95!!!! \n \n Get it today! \n"
      case "NEW"
        Print "Creating new file, PritchBASIC_OUT.bas!"
        Open "PritchBASIC_OUT.bas" for Output as #1
          Print #1, "Do"
          Print #1, !"Print \"APRIL FOOLS!!!\""
          Print #1, "Loop until multikey(&h01)"
        Close #1
      Case "PRINT"
        Print !"I'm sorry, but this command is only available in the PremiumBASIC package \n for PritchBASIC! \n Do not fret though!  The PremiumBASIC Package only costs \n \n $5995.95!!!! \n \n Get it today! \n"
      case "QUIT"
        Print !"I'm sorry, but this command is only available in the PremiumBASIC package \n for PritchBASIC! \n Do not fret though!  The PremiumBASIC Package only costs \n \n $5995.95!!!! \n \n Get it today! \n"
      case else
        Print !"I'm sorry, but this command is only available in the PremiumBASIC package \n for PritchBASIC! \n Do not fret though!  The PremiumBASIC Package only costs \n \n $5995.95!!!! \n \n Get it today! \n"
      End Select
     
    End if
   
      '' They got it wrong ;_;
    Return 0
  End Function
 
  Sub QuestionList.NewQuestion( ByVal QuestionVal as ZString ptr, ByVal AnswerVal as ZString ptr, _
                                ByVal ResponseIfRight as ZString Ptr, ByVal ResponseIfWrong as Zstring ptr)
   
      '' Resize the list of questions
    This.Q = Reallocate( This.Q, Sizeof( Question Ptr ) * ( This.NumQ + 1 ) )
    This.Q[This.NumQ] = New Question
   
      '' Resize the question list
    This.Q[This.NumQ]->Q = allocate( sizeof(Zstring) * ( Len(*QuestionVal) + 1 ) )
    This.Q[This.NumQ]->A = allocate( sizeof(Zstring) * ( Len(*AnswerVal) + 1 ) )
    This.Q[This.NumQ]->RA = allocate( sizeof(Zstring) * ( Len(*ResponseIfRight) + 1 ) )
    This.Q[This.NumQ]->WA = allocate( sizeof(Zstring) * ( Len(*ResponseIfWrong) + 1 ) )
   
      '' Put the appropriate text into the question list
    *This.Q[This.NumQ]->Q = *QuestionVal
    *This.Q[This.NumQ]->A = *AnswerVal
    *This.Q[This.NumQ]->RA = *ResponseIfRight
    *This.Q[This.NumQ]->WA = *ResponseIfWrong
   
      '' Tell the type we have one more question in our list
    This.NumQ += 1
   
  End Sub
 
End NameSpace
Tyr_Anassazi
Posts: 26
Joined: Jul 01, 2013 15:01
Location: Russia, Novosibirsk
Contact:

Re: PritchBASIC 2015 - Successor to FreeBASIC with Embedded

Postby Tyr_Anassazi » Apr 01, 2015 15:54

1st april joke! And it worked for me! For about 20 seconds I seriously thought it was a thingee as advertised in the title! Then I read the code and... april fish. Image

Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 2 guests