home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / grphega / 3drandot.arj / 3DEGA.BAS next >
Encoding:
BASIC Source File  |  1992-02-04  |  3.1 KB  |  122 lines
  1. DECLARE SUB DRAWDOTS (WID!)
  2. DECLARE SUB RANDSTRIP (WID%, XFGCLR%, XBGCLR%)
  3. DECLARE SUB COMLINE (NumArgs%, ARGS$(), MAXARGS%)
  4. DECLARE SUB THREED (WID%, DEPTH%)
  5. CONST VSIZE = 350, MAXARGS = 1
  6. DIM ARGS(1 TO MAXARGS) AS STRING
  7. DIM PICNAME AS STRING
  8. DIM SHARED SEED AS LONG
  9. CALL COMLINE(NARGS%, ARGS(), MAXARGS)
  10. IF NARGS% <> MAXARGS THEN GOTO INSTRUCTIONS
  11.  
  12. PICNAME = ARGS(1)
  13. SCREEN 9
  14. FGCOLOR% = 0
  15. BGCOLOR% = 15
  16. SHELL "VPIC " + PICNAME + " /A /R"
  17. RANDOMIZE TIMER
  18. CONST WIDE = 60
  19. CALL DRAWDOTS(WIDE)
  20. CALL RANDSTRIP(WIDE, FGCOLOR%, BGCOLOR%)
  21. CALL THREED(WIDE, 5)
  22. WHILE INKEY$ = ""
  23. WEND
  24. END
  25.  
  26. INSTRUCTIONS:
  27. SCREEN 0
  28. COLOR 11, 1
  29. PRINT "Usage: 3DEGA Pic-Filename(650x350x16)"
  30. PRINT
  31. PRINT "This program takes a picture file and displays it using a picture viewer"
  32. PRINT "like VPIC 4.5 from Bob Montgomery. The picture file must be EGA"
  33. PRINT "650 x 350 and with 16 colors."
  34. PRINT
  35. PRINT "Once the picture is displayed, it is converted into a 3D random dot"
  36. PRINT "stereogram. The height of objects in the 3D picture are based on the"
  37. PRINT "numerical value of the colors. Black = 0, Blue = 1, etc."
  38. PRINT "After the stereogram is completed, use a screen capture program to"
  39. PRINT "save it to disk or hit Print Screen to print it on a graphics printer."
  40. PRINT
  41. PRINT "Note: If you are going to use DOS 5 QBASIC, remove subproc COMLINE."
  42. PRINT
  43. END
  44.  
  45. DEFINT A-Z
  46. SUB COMLINE (NumArgs, ARGS$(), MAXARGS) STATIC
  47.  
  48. CONST TRUE = -1, FALSE = 0
  49.  
  50.    NumArgs = 0: in = FALSE
  51. ' Get the command line using the COMMAND$ function.
  52.    Cl$ = COMMAND$
  53.    L = LEN(Cl$)
  54. ' Go through the command line a character at a time.
  55.    FOR I = 1 TO L
  56.       C$ = MID$(Cl$, I, 1)
  57.     'Test for character being a blank or a tab.
  58.       IF (C$ <> " " AND C$ <> CHR$(9)) THEN
  59.     ' Neither blank nor tab.
  60.     ' Test to see if you're already
  61.     ' inside an argument.
  62.          IF NOT in THEN
  63.       ' You've found the start of a new argument.
  64.       ' Test for too many arguments.
  65.             IF NumArgs = MAXARGS THEN EXIT FOR
  66.             NumArgs = NumArgs + 1
  67.             in = TRUE
  68.          END IF
  69.      ' Add the character to the current argument.
  70.          ARGS$(NumArgs) = ARGS$(NumArgs) + C$
  71.       ELSE
  72.    ' Found a blank or a tab.
  73.    ' Set "Not in an argument" flag to FALSE.
  74.          in = FALSE
  75.       END IF
  76.    NEXT I
  77.  
  78.  
  79.  
  80. END SUB
  81.  
  82. DEFSNG A-Z
  83. SUB DRAWDOTS (WID)
  84. X = 640 / 2 - WID / 2
  85. CIRCLE (X, 4), 4, 16
  86. PAINT STEP(0, 0), 16
  87. CIRCLE (X + WID, 4), 4, 16
  88. PAINT STEP(0, 0), 16
  89. END SUB
  90.  
  91. DEFINT W-Z
  92. SUB RANDSTRIP (WID, XFGCLR, XBGCLR)
  93. FOR Y = 10 TO VSIZE - 1
  94.   IF INKEY$ <> "" THEN END
  95.   FOR X = 0 TO WID - 1
  96.      IF RND > .55 THEN
  97.        COLOR XFGCLR
  98.      ELSE
  99.        COLOR XBGCLR
  100.      END IF
  101.      PSET (X, Y)
  102.   NEXT X
  103. NEXT Y
  104. END SUB
  105.  
  106. DEFINT A-V
  107. SUB THREED (WID, DEPTH)
  108. FOR ROW = 1 TO 640 / WID - 1
  109.   IF INKEY$ <> "" THEN END
  110.   XROW = WID * ROW
  111.   FOR Y = 10 TO VSIZE - 1
  112.     FOR X = 0 TO WID - 1
  113.       THISX = XROW + X
  114.       THISPIX = POINT(THISX, Y)
  115.       THISPIX = POINT(THISX - WID + THISPIX, Y)
  116.       PSET (THISX, Y), THISPIX
  117.     NEXT X
  118.   NEXT Y
  119. NEXT ROW
  120. END SUB
  121.  
  122.