'===========================================================================
' Subject: 3D STEROGRAM                      Date: 05-23-96 (13:34)       
' Author:  Brendan Price                     Code: QB, QBasic, PDS        
' Origin:  Bprice@sebas.vic.edu.au         Packet: EGAVGA.ABC
'===========================================================================
'This program creates 3d pictures like the ones in magic eye books.
'At the moment, the image is of my initials, but that can easily be
'changed. The code is EGA, small and tight, with heaps of remarks,
'for QuickBasic. Have fun!

' 3D stereogram program
' by Brendan Price.
' Bprice@sebas.vic.edu.au

' QuickBasic 4.5

DECLARE SUB MakeImage ()
DECLARE SUB Randomiser ()
DECLARE SUB BoxAdd (Tlx%, Tly%, Brx%, Bry%, dep%)
DECLARE SUB DrawObject ()

' Arrays can be made larger for better resolution, you'll need to adjust
' the drawobject routine. This was, however, the limit of my 1mb memory!

DIM SHARED mapping(200, 100) AS INTEGER
DIM SHARED Lines(100) AS SINGLE
DIM SHARED Imager(20, 100) AS INTEGER


PRINT "Working . . ."
MakeImage
Randomiser
DrawObject
SLEEP  'so you can get a good look, or print it off if you want
       ' to print, simply load GRAPHICS.COM before you run this program,
       ' then use PrintScrn. It looks good even in 9-pin black and white!




' Adds a box shape to the 3D image mapping, raised above the plane
' by dep% units.
SUB BoxAdd (Tlx%, Tly%, Brx%, Bry%, dep%)
 PRINT "Adding Box . . . ."; dep%
 IF dep% = 0 THEN
  FOR x = Tlx% TO Brx%
   FOR y = Tly% TO Bry%
    mapping(x, y) = 0
   NEXT
  NEXT
 ELSE
  FOR x = Tlx% TO Brx% STEP 20
   FOR y = Tly% TO Bry%
    mapping(x, y) = dep%
   NEXT
  NEXT
 END IF
END SUB

SUB DrawObject
' This generates the 3D image in an EGA mode
CLS : SCREEN 9
FOR x = 1 TO 199
 FOR y = 1 TO 99
  g = g + 1
  IF g = 21 THEN g = 1
  Lines(y) = Lines(y) + mapping(x, y)
  pa = x - Lines(y)
  IF pa > 0 AND pa < 180 THEN
   LINE (pa * 2, y * 2)-(pa * 2 + 1, y * 2 + 1), Imager(g, y), BF
   ' A pset function, a higher res mode and larger array sizes could
   ' be used, but will require bigger arrays and speed. Feel free to
   ' experiment yourself.
   END IF
 NEXT
NEXT
END SUB

SUB MakeImage
' This generates the mapping of the image. This routine will
' eventually be replaced by a mouse draw routine, but in the
' meantime, it's okay to just design on paper and put the
' numbers in below.

' BigB
BoxAdd 40, 10, 80, 90, 1
BoxAdd 50, 20, 70, 45, 0
BoxAdd 50, 55, 70, 80, 0
BoxAdd 70, 10, 80, 20, 0
BoxAdd 70, 80, 80, 90, 0

' BigP
BoxAdd 100, 10, 140, 90, 1
BoxAdd 110, 20, 130, 45, 0
BoxAdd 110, 55, 140, 90, 0

' Small symbol in foreground
BoxAdd 85, 30, 95, 33, 2
BoxAdd 85, 48, 95, 50, 2
BoxAdd 89, 39, 95, 41, 3
            
END SUB

SUB Randomiser
' This creates a random plane of pixels, about 20 wide, to be repeated
' across the image. This routine could also be replaced with a mousedraw
' or perhaps even a scanned image.
RANDOMIZE
PRINT "Creating Random Plane ..."
FOR t = 1 TO 20
FOR s = 1 TO 100
Imager(t, s) = INT(RND * 15)
NEXT s, t
END SUB