QB / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

 Return to Index  

Program that creates and runs a program.

March 17 2006 at 12:06 AM
  (Login MCalkins)
Moderator


Response to Fun challenge - 'Hello World'

 
Check out the GOTO chain in the resulting program.
Warning: If you have a file called "hwdoom!!.bas" it will be overwritten!
Regards,
Michael

DEFINT A-Z
DECLARE FUNCTION factor$ (f)
RANDOMIZE TIMER
DIM us(0 TO 1662)

w = 0
FOR c = 0 TO 1661
 us(w) = -1
 DO
  d = INT(RND * 1662) + 1
 LOOP WHILE us(d)
 us(w) = d
 w = d
NEXT c
FOR i = 0 TO 1662
 IF us(i) = 0 THEN us(i) = 1663: EXIT FOR
NEXT i


SCREEN 12: WIDTH 80, 30
CLS
PALETTE 15, 0
PRINT "Hello, World!"
sx = 108
sy = 92
OPEN "hwdoom!!.bas" FOR OUTPUT AS 1
PRINT #1, "defint a-z"
PRINT #1, "screen 13"
PRINT #1, "palette 16,0"
PRINT #1, "randomize timer"
PRINT #1, "cls"
PRINT #1, ""
FOR x = 0 TO 103
 FOR y = 0 TO 15
  i = (x * 16) + y
  IF (x > 0) OR (y > 0) THEN PRINT #1, LTRIM$(STR$(i)); " ";
  PRINT #1, "pset("; factor$(x + sx); " ,"; factor$(y + sy); "), ";
  IF POINT(x, y) THEN PRINT #1, "16" ELSE PRINT #1, "0"
  IF i < 1663 THEN PRINT #1, "GOTO"; STR$(us(i))
 NEXT y
NEXT x
CLS
PALETTE
SCREEN 0: WIDTH 80, 25
PRINT #1, ""
PRINT #1, "do"
PRINT #1, " x = int(rnd * 104) +"; STR$(sx)
PRINT #1, " y = int(rnd * 16) +"; STR$(sy)
PRINT #1, " if point(x, y) then pset (x, y), int(rnd * 15) + 1"
PRINT #1, "loop until len(inkey$)"
PRINT #1, "palette"
PRINT #1, "screen 0: width 80, 25"
PRINT #1, "system"
CLOSE
RUN "hwdoom!!.bas"

FUNCTION factor$ (f)
 n = f
 t = 2
 notfirst = 0
 DO WHILE t < n
  IF n MOD t = 0 THEN
   n = n \ t
   IF notfirst THEN
    s$ = s$ + " *" + STR$(t)
   ELSE
    s$ = LTRIM$(STR$(t))
    notfirst = -1
   END IF
  ELSE
   t = t + 1
  END IF
 LOOP
 IF notfirst THEN
  IF n > 1 THEN s$ = s$ + " *" + STR$(n)
 ELSE
  s$ = LTRIM$(STR$(n))
 END IF
 factor$ = s$
END FUNCTION


    
This message has been edited by MCalkins on Mar 17, 2006 12:07 AM


 
 Respond to this message   
Responses

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement