New Challenges

[na_th_an]

Hey! Just to know what you think.

After Wizardlife game challenge has finished, I challenge to everyone of you to make a cool, fast arcade game in SCREEN 1. It has to be in a single module (no libs) but can use ASM if you like (some memcopy routine and such, using POKE and CALL ABSOLUTE dummies).

Tell me if you like this, and if you do, we can have it after WL's game challenge ends.

[wizardlife]

Hey! Just to know what you think.

After Wizardlife game challenge has finished, I challenge to everyone of you to make a cool, fast arcade game in SCREEN 1. It has to be in a single module (no libs) but can use ASM if you like (some memcopy routine and such, using POKE and CALL ABSOLUTE dummies).

Tell me if you like this, and if you do, we can have it after WL's game challenge ends.

Cool. Do you mean basically the same rules: no external files, but the /lqb parameter is allowed? Sounds good. In Screen 1, you could get way faster than in the one we're using. Only three colours to deal with and 320x200 rez. You should post instructions for writing a pixel, the same as the other one...

[eKrax]

there was a challange a few months ago on qb45.com and someone named generic did it in 5 lines! ill try and find it...

[LooseCaboose]

It was my self replicating code contest, I posted it on QB45.com after nobody here got it. Generic got the shortest version with only 5 lines (although one of the lines was really long). I dont have generics version (or the others that also posted with working solutions) and I cant locate my 10 line solution right now either. Ill have a look later and post it.

[LooseCaboose]

Found it. Here is a ten line program, that when run prints its own source code on the screen (nothing less, nothing more):

Code:

DIM a$(5)
DATA DIM a$(5)
FOR i = 1 to 5
DATA FOR i = 1 to 5
READ a$(i)
DATA READ a$(i)
PRINT a$(i) + CHR$(13) + "DATA " + a$(i)
DATA PRINT a$(i) + CHR$(13) + "DATA " + a$(i)
NEXT
DATA NEXT

[eKrax]

nice tricky code there.. and makes sense, but back to generics solution.. how the hell did that work??? it had like a huge hex string...

[LooseCaboose]

I think that Generics solution worked by having the entire code for the program imbeded in the hex string. The program printed out the contents of the hex string and then then each item of the hex string as a character. I didnt look to closely at it though (fear of brain imploding). Im not sure if Generic wrote it directly or used another program to generate the code (it would be tricky to manually figure out the hex string for printing itself??)

[Generic]

Hi :)

The program stored itself in a hex string as you suggested but the challenge was to get it to fit into less than 255 characters as this is the line limit of QB! ie this:

p$ = "A0868768EF987E..."

had to be less than 255.

It then printed:

print "p$ = "+chr$(34)+p$+chr$(34)

Or something like that. p$ contained the hex for the code for printing p$ (this was generated by another program which scanned through the .bas file).  I can't find the code anywhere so I can post it, sorry

:)

[oracle]

I saw the pi program challenge for newbies, and I thought I'd give it a try... I can calculate it precisely but qbasic only will let me output it to 15 significant figures... help anyone?  ::

[someone42]

I did this some time ago:

Code:

DECLARE SUB BigMul (op1 AS STRING, op2 AS INTEGER)
DECLARE SUB BigAdd (op1 AS STRING, op2 AS STRING)
DECLARE SUB BigSub (op1 AS STRING, op2 AS STRING)
DECLARE SUB BigDiv (op1 AS STRING, op2 AS INTEGER)
DIM SHARED x AS STRING * 512
DIM SHARED x2 AS STRING * 512
DIM SHARED x3 AS STRING * 512
DIM SHARED x4 AS STRING * 512

CLS

x = CHR$(1) + CHR$(0) + STRING$(510, 0)
BigDiv x, 5
x3 = x

PRINT "Calculating atn(1/5):";
FOR a = 0 TO 878
  LOCATE 1, 22: PRINT a + 1; "/ 879"
  BigDiv x, 25
  x2 = x
  BigDiv x2, a * 2 + 3
  IF a AND 1 THEN
    BigAdd x3, x2
  ELSE
    BigSub x3, x2
  END IF
NEXT a

x = CHR$(1) + CHR$(0) + STRING$(510, 0)
BigDiv x, 239
x4 = x

PRINT "Calculating atn(1/239):";
FOR a = 0 TO 257
  LOCATE 2, 24: PRINT a + 1; "/ 258"
  BigDiv x, 239
  BigDiv x, 239
  x2 = x
  BigDiv x2, a * 2 + 3
  IF a AND 1 THEN
    BigAdd x4, x2
  ELSE
    BigSub x4, x2
  END IF
NEXT a

BigMul x3, 4
BigSub x3, x4
BigMul x3, 4

PRINT "PI = ";
FOR t% = 1 TO 1000
  PRINT LTRIM$(STR$(ASC(MID$(x3, 1, 1)) MOD 10));
  IF t% = 1 THEN PRINT ".";
  MID$(x3, 1, 1) = CHR$(0)
  BigMul x3, 10
NEXT t%

SUB BigAdd (op1 AS STRING, op2 AS STRING)

  carry& = 0
  FOR c% = 511 TO 1 STEP -2
    add1& = CVL(MID$(op1, c%, 2) + CHR$(0) + CHR$(0))
    add2& = CVL(MID$(op2, c%, 2) + CHR$(0) + CHR$(0))
    thing& = add1& + add2& + carry&
    IF thing& > 65536 THEN
      thing& = thing& - 65536
      carry& = 1
    ELSE
      carry& = 0
    END IF
    IF thing& > 32767 THEN thing& = thing& - 65536
    MID$(op1, c%, 2) = MKI$(thing&)
  NEXT c%

END SUB

SUB BigDiv (op1 AS STRING, op2 AS INTEGER)

  numq& = CVL(MID$(op1, 1, 2) + CHR$(0) + CHR$(0)) \ op2
  numr& = CVL(MID$(op1, 1, 2) + CHR$(0) + CHR$(0)) MOD op2
  MID$(op1, 1, 1) = CHR$(numq& AND 255)
  MID$(op1, 2, 1) = CHR$(numq& \ 256)
  nextval$ = CHR$(numr& AND 255) + CHR$(numr& \ 256)
  FOR c% = 3 TO 511 STEP 2
    numq& = CVL(MID$(op1, c%, 2) + nextval$) \ op2
    numr& = CVL(MID$(op1, c%, 2) + nextval$) MOD op2
    MID$(op1, c%, 1) = CHR$(numq& AND 255)
    MID$(op1, c% + 1, 1) = CHR$(numq& \ 256)
    nextval$ = CHR$(numr& AND 255) + CHR$(numr& \ 256)
  NEXT c%

END SUB

SUB BigMul (op1 AS STRING, op2 AS INTEGER)

  carry& = 0
  FOR c% = 511 TO 1 STEP -2
    mul& = CVL(MID$(op1, c%, 2) + CHR$(0) + CHR$(0))
    thing& = mul& * op2 + carry&
    carry& = thing& \ 65536
    thing& = thing& AND 65535
    IF thing& > 32767 THEN thing& = thing& - 65536
    MID$(op1, c%, 2) = MKI$(thing&)
  NEXT c%

END SUB

SUB BigSub (op1 AS STRING, op2 AS STRING)
 
  borrow& = 0
  FOR c% = 511 TO 1 STEP -2
    sub1& = CVL(MID$(op1, c%, 2) + CHR$(0) + CHR$(0))
    sub2& = CVL(MID$(op2, c%, 2) + CHR$(0) + CHR$(0))
    thing& = sub1& - sub2& - borrow&
    IF thing& < 0 THEN
      thing& = thing& + 65536
      borrow& = 1
    ELSE
      borrow& = 0
    END IF
    IF thing& > 32767 THEN thing& = thing& - 65536
    MID$(op1, c%, 2) = MKI$(thing&)
  NEXT c%

END SUB

[oracle]

Damn... if it is getting that tricky then it probably isn't a problem for newbies...  ::  ::  I don't understand what is happening in there. The way I calculate pi is like this: pi = 4 * ATN(1). This is pi exactly but can only be printed to 15 s.f.

Mofu, have you solved it?

Or Neo???

ps: when I tried to modify your prog to calculate pi to 10000 places someone42, it started printing zeroes after a while. What have I done wrong? Or is it a message from aliens.. :rotfl:

I can make a program that prints its source in 4 lines, but it uses files... )

Here is a program that encrypts a string, and can decrypt it again. Any queries, suggestions etc I would appreciate

Code:

'                       -- Encryption Program --

'                          - By The Oracle -

'  This program takes an inputted string and encodes it to a file. You can

'  also use this program to decode. It is based on a simple encoding

'  technique, "using a keyword". Basically even if the numbers in the file

'  are the same they could be two different letters because every letter

'  is encoded differently.


DECLARE SUB getkeywords ()

DIM SHARED keywords(1 TO 5) AS STRING

RANDOMIZE TIMER

getkeywords

CLS
LOCATE 10, 15
COLOR 9
PRINT "Welcome to The Oracle's Encryption Program"
LOCATE 12, 25
COLOR 15
PRINT "1) Encrypt message"
LOCATE 13, 25
PRINT "2) Decrypt message"
LOCATE 14, 25
PRINT "3) Exit"
LOCATE 16, 25
INPUT "Your choice? ", choice$

IF choice$ = "1" THEN
  GOTO encryption
ELSEIF choice$ = "2" THEN
  GOTO decryption
ELSEIF choice$ = "3" THEN
  END
ELSEIF choice$ = CHR$(27) THEN
  END
ELSE
  RUN
END IF

' I wouldn't normally use GOTO, but you can't redim arrays when inside

' subroutines as far as I am aware...  Anyone know how???

encryption:

CLS
k = INT(RND * 5) + 1

FOR a = 1 TO LEN(keywords(k))
  codes(a) = ASC(MID$(keywords(k), a, 1))  ' Store the ASCII codes in an array
NEXT a

INPUT "Type a string you want to encrypt: ", encrypt$
IF encrypt$ = CHR$(27) THEN END
INPUT "Type a name for the file the info is stored in: ", filename$
IF filename$ = CHR$(27) THEN END
IF RIGHT$(filename$, 4) <> ".txt" THEN filename$ = filename$ + ".txt"

DIM SHARED enc(1 TO LEN(encrypt$)) AS INTEGER

OPEN filename$ FOR OUTPUT AS #1
FOR b = 1 TO LEN(encrypt$)        ' For each character
  IF b > LEN(keywords(k)) + c THEN c = c + LEN(keywords(k)) ' If the character
                                                            ' number is greater
                                                            ' than the keyword
                                                            ' start from the
                                                            ' start of the keyword
  enc(b) = ASC(MID$(encrypt$, b, 1)) + codes(b - c)         ' This is simple encoding
  PRINT #1, STR$(enc(b))                                    ' Print to file
NEXT b
CLOSE

PRINT "Your key is"; k; ". Don't lose it!!!"
WHILE INKEY$ = "": WEND
RUN

decryption:

CLS
INPUT "Enter your keycode: ", k
INPUT "Enter the filename: ", filename$

IF RIGHT$(filename$, 4) <> ".txt" THEN filename$ = filename$ + ".txt"
OPEN filename$ FOR INPUT AS #1
DO UNTIL EOF(1)   ' This loop simply counts the number of lines
  INPUT #1, a$
  d = d + 1
LOOP
CLOSE      ' How do you reposition the cursor at the beginning of a file?
           ' I've used CLOSE and OPEN

OPEN filename$ FOR INPUT AS #1

DIM decodes(1 TO d) AS INTEGER    ' Array for storing the codes from the file

FOR o = 1 TO d      ' Get the numbers in the file
  INPUT #1, a%
  decodes(o) = a%
NEXT o

FOR a = 1 TO LEN(keywords(k))              ' Get the codes of the keyword
  codes(a) = ASC(MID$(keywords(k), a, 1))
NEXT a

DIM SHARED enc(1 TO d) AS INTEGER     ' Array for the actual message
FOR l = 1 TO d
  IF l > LEN(keywords(k)) + c THEN c = c + LEN(keywords(k))
  enc(l) = decodes(l) - codes(l - c)       ' Decode the string
  PRINT CHR$(enc(l));                      ' Print the result
NEXT l
WHILE INKEY$ = "": WEND
RUN

END

SUB getkeywords

keywords(1) = "roast"
keywords(2) = "qbasic"
keywords(3) = "mouse"
keywords(4) = "oracle"
keywords(5) = "algorithm"

END SUB

 

[someone42]

The way I calculate pi is like this: pi = 4 * ATN(1)

That's exactly what I do, just with higher precision calculations that allow more than 17 digits.
Oh yeah and I got this from some site:
atn(1) = 4 * atn(1/5) - atn(1/239)

when I tried to modify your prog to calculate pi to 10000 places someone42, it started printing zeroes after a while

Are you just changing the "FOR t% = 1 to 1000" line? The numbers I use are 4096-bit numbers, which can hold 1233 decimal digits. You have to change other things. I have tried to get it to give 10000 digits but for some utterly strange reason after about 2000 digits everything is *wrong*.

[oracle]

Maybe because qbasic works in binary...