Sorry your browser is not supported!

SCREEN 7

DATA 01,01,02,03,04,05
DATA 01,01,02,03,04,05
DATA 01,01,02,03,04,05
DATA 01,01,02,03,04,05
DATA 01,01,02,03,04,05
DATA 01,01,02,03,04,05

xlength = 6
ylength = 6

FOR y = 1 TO ylength
      FOR x = 1 TO xlength
            READ z
            PSET (x, y), z
      NEXT
NEXT

DIM rainbow(xlength * ylength)

GET (0, 0)-(xlength, ylength), rainbow

CLS
PUT (x, y), rainbow

'  _____ __              
' /_  _// /__ ____                 þ WAVPLAY.BAS  þ
'  / / / _  //___/                 þ  taken from  þ
' /_/ /_//_//___/
'         ________  __    _____    _______  __  ______
'        / ____  / / /   /__     / _____/ /_/ / ____/ 
'       / /   / / / /__  ___/  / / /____  __  / /
'      / /   / / / __ / / __  / /____  / / / / /
'     / /___/ / / /_// / /_/ / _____/ / / / / /____
'    /____  _/ /____/ /_____/ /______/ /_/ /______/
'         _                              ____  ____   _____   _____
'                                         /__ / /_  /  / ___/  / ___/
'http://www.wp.com/80948/qb/             //_// __/ /  / /___  / /__
'mallard@gcomm.com                      / __/ /   /  / /_/ / / /___   
'                                      /_/   /___/  /_____/ /_____/
'
'program information
'
'FILENAME: WAVPLAY.BAS
'AUTHOR  : unknown - taken from Jon Carter       E-MAIL: unknown
'DESCRIPTION: QBasic WAV player that really works quick and fast.
'DATE ADDED: 07 Nov 1996
'SIZE      : 10,399 bytes
DECLARE SUB PlayWav (wavefile$)
DECLARE SUB ValidWavHeader (FILE$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%)
DECLARE SUB WriteToDSP (v%)
DECLARE SUB PlayBack (buffer$, size%, freq&, BytesPerSec&, chans%, num%)
DECLARE SUB delay (tdelay!)
DECLARE FUNCTION GetBlasterAddr% ()
DECLARE FUNCTION SBreset% ()
COMMON SHARED BlasterAddr%, dma%, repeats%

PlayWav "c:windowssoundboot.wav"

DEFINT A-Z
'------------------------------------------------------------------------------
SUB delay (tdelay!)
time1! = TIMER
DO
LOOP WHILE (TIMER - time1! < tdelay!) OR (time1! > TIMER)
END SUB

'------------------------------------------------------------------------------
FUNCTION GetBlasterAddr%
'Get Blaster Address and DMA channel from Environment Variable
tmp% = 0  'No Environment Variable Set...default
blast$ = UCASE$(ENVIRON$("BLASTER"))
IF LEN(blast$) THEN
   tmp% = INSTR(blast$, "A")
   tmp1$ = MID$(blast$, tmp% + 1, 3)
   tmp% = VAL("&H" + tmp1$)
   IF tmp% = 203 THEN tmp% = -1    'If there is no value assigned
   IF tmp% > 0 THEN
      tmp2% = INSTR(blast$, "D")
      dma% = VAL(MID$(blast$, tmp2% + 1))        'dma% is a global variable
      IF dma% < 0 OR dma% > 7 THEN tmp% = -2
   END IF
END IF
GetBlasterAddr% = tmp%
END FUNCTION

'------------------------------------------------------------------------------
SUB PlayBack (buffer$, size%, freq&, BytesPerSec&, chans%, num%)
size% = size% - 1
segment& = VARSEG(buffer$)
offset& = SADD(buffer$)
IF segment& < 0 THEN segment& = segment& + 65536
IF offset& < 0 THEN offset& = offset& + 65536
baseaddr& = segment& * 16 + offset&
look1% = VARPTR(baseaddr&)
look2% = VARPTR(size%)
SELECT CASE dma%
   CASE 0
      dmapage% = &H87   '135 decimal
      dmaaddr% = 0
      dmalen% = 1
   CASE 1
      dmapage% = &H83   '131 decimal
      dmaaddr% = 2
      dmalen% = 3
   CASE 2
      dmapage% = &H81
      dmaaddr% = 4
      dmalen% = 5
   CASE 3
      dmapage% = &H82
      dmaaddr% = 6
      dmalen% = 7
   CASE 4
      dmapage% = &H8F
      dmaaddr% = &HC0
      dmalen% = &HC2
   CASE 5
      dmapage% = &H8B
      dmaaddr% = &HC4
      dmalen% = &HC6
   CASE 6
      dmapage% = &H89
      dmaaddr% = &HC8
      dmalen% = &HCA
   CASE 7
      dmapage% = &H8A
      dmaaddr% = &HCC
      dmalen% = &HCE
END SELECT
SELECT CASE dma%
   CASE 0 TO 3
      dmamask% = &HA
      dmamode% = &HB
      dmaclear% = &HC
      dmastatus% = &H8
   CASE 4 TO 7
      dmamask% = &HD4
      dmamode% = &HD6
      dmaclear% = &HD8
      dmastatus% = &HD0
END SELECT
SELECT CASE dma%
   CASE 0, 4
      dmaterminal% = 1   'bit 0 of status register (&H08 or &HD0)
   CASE 1, 5
      dmaterminal% = 2   'bit 1
   CASE 2, 6
      dmaterminal% = 4   'bit 2
   CASE 3, 7
      dmaterminal% = 8   'bit 3
END SELECT

OUT dmamask%, dma% + 4   'mask the dma channel
OUT dmaclear%, &H0       '(clear the internal DMA flip/flop)
OUT dmamode%, 72 + dma%  '  72=010010XX where XX=dmachannel%
OUT dmaaddr%, PEEK(look1%)      'bits 0-7 of  the 20bit address
OUT dmaaddr%, PEEK(look1% + 1)  'bits 8-15 of the 20bit address
OUT dmapage%, PEEK(look1% + 2)  'bits 16-19 of the 20 bit address
OUT dmalen%, PEEK(look2%)       'bits 0-7 of size%
OUT dmalen%, PEEK(look2% + 1)   'bits 8-15  of size%
OUT dmamask%, dma%              'enable channel

IF num% = 1 THEN  'only need to Write out time constant once
   timeconst% = 256 - 1000000 / (freq& * chans%)
   CALL WriteToDSP(&H40)
   CALL WriteToDSP(timeconst%)
   'Reset Mixer    DSPmixeraddress = Blasteraddr% + &H4
   OUT BlasterAddr% + &H4, &H0
   OUT BlasterAddr% + &H4 + 1, 0
   'Set Volume to Maximum...255
   OUT BlasterAddr% + &H4, &H22
   OUT BlasterAddr% + &H4 + 1, 255
   IF chans% = 2 THEN
      'Set mixer to Stereo Output
      OUT BlasterAddr% + &H4, &HE
      OUT BlasterAddr% + &H4 + 1, 34      '34=2^5+2^1
   END IF
END IF
IF BytesPerSec& > 22000 THEN
   CALL WriteToDSP(&H48)   'Set Block Size
ELSE
   CALL WriteToDSP(&H14)   'DMA Mode 8-bit DAC
END IF
CALL WriteToDSP(PEEK(look2%))      'Lo byte of address
CALL WriteToDSP(PEEK(look2% + 1))  'High byte of address
IF BytesPerSec& > 22000 THEN CALL WriteToDSP(&H91)  'High Speed DMA mode 8-bit
dummy% = INP(dmastatus%)    'Read status byte once to make sure DMA is going.
WAIT dmastatus%, dmaterminal%   'Loop until terminal count bit set in DMA status register
'DMA Transfer is Now Complete
'Acknowledge the DSP interrupt by reading the DATA AVAILABLE port once
dummy% = INP(BlasterAddr% + &HE)    'DSP Available address
END SUB

DEFSNG A-Z
SUB PlayWav (wavefile$)


repeats% = 1
BlasterAddr% = GetBlasterAddr%
SELECT CASE BlasterAddr%
   CASE -2
      PRINT "Bad DMA Channel specified!"
      END
   CASE -1
      PRINT "No Port Base Address Given!"
      END
   CASE 0
      PRINT "No BLASTER Environment Variable Set!"
      END
   CASE ELSE
      'Assume a valid Address Exists
'      PRINT "Blaster Address = "; HEX$(BlasterAddr%)
END SELECT
IF NOT SBreset% THEN
   PRINT "SoundBlaster Card Would Not Reset!"
   END
END IF

sp% = INSTR(Spec$, " ")
IF sp% THEN
   wavefile$ = LEFT$(Spec$, sp% - 1)
   repeats% = VAL(RIGHT$(Spec$, LEN(Spec$) - sp%))
   IF repeats% = 0 THEN repeats% = 1
ELSE
   IF LEN(Spec$) THEN
      wavefile$ = Spec$
      repeats% = 1
   END IF
END IF

IF LEN(wavefile$) = 0 THEN
END IF
'wavefile$ = "C:QBASICTHEME.WAV"
CALL ValidWavHeader(wavefile$, LenHeader%, WavLen&, Channels%, Sampling&, bytes&, ok%)

IF NOT ok% THEN
   PRINT "Bad Wave File Format"
   END
END IF

MaxBuffer% = 7053

CALL WriteToDSP(&HD1)  'Speaker ON
FOR repeat% = 1 TO repeats%    'This can loop to play the file ii% times]
filenum% = FREEFILE
   OPEN wavefile$ FOR BINARY AS filenum%
      num% = 0
      SEEK filenum%, LenHeader% + 1
      Remaining& = WavLen&
      DO
         num% = num% + 1
         IF Remaining& > MaxBuffer% THEN
            BufferLen% = MaxBuffer%
         ELSE
            BufferLen% = Remaining&
         END IF
         Remaining& = Remaining& - BufferLen%
         buffer$ = SPACE$(BufferLen%)
         GET filenum%, , buffer$
         CALL PlayBack(buffer$, BufferLen%, Sampling&, bytes&, Channels%, num%)
      LOOP WHILE Remaining& > 0
      OUT &H20, &H20   'Reset Normal Interrupt Service
   CLOSE filenum%
NEXT repeat%
CALL WriteToDSP(&HD3)  'Speaker OFF

END SUB

DEFINT A-Z
'------------------------------------------------------------------------------
FUNCTION SBreset%
'DSPreset% = address% + &H6
'DSPread% = address% + &HA
'DSPwrite% = address% + &HC
'DSPavail% = address% + &HE
'DSPmixer% = address% + &H4
OUT BlasterAddr% + &H6, 1   'Reset address
delay .1
OUT BlasterAddr% + &H6, 0
time1! = TIMER: noreset% = 0
DO
   'Read Data Available port until bit 7 is set
   'This should take about 100 micro seconds...give it 1 full second
   IF TIMER - time1! > 1! THEN noreset% = -1
LOOP UNTIL ((INP(BlasterAddr% + &HE) AND 128) = 128) OR noreset%
IF NOT noreset% THEN
   IF INP(BlasterAddr% + &HA) = &HAA THEN
      SBreset% = -1
   ELSE
      SBreset% = 0
   END IF
ELSE
   SBreset% = 0
END IF
END FUNCTION

'------------------------------------------------------------------------------
SUB ValidWavHeader (FILE$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%)
rID$ = SPACE$(4)
wID$ = SPACE$(4)
fID$ = SPACE$(4)
dat$ = SPACE$(4)
dummy$ = SPACE$(1)

filenum% = FREEFILE
OPEN FILE$ FOR BINARY AS filenum%
  GET filenum%, , rID$
  GET filenum%, , rLen&
  GET filenum%, , wID$
  GET filenum%, , fID$
  GET filenum%, , fLen&
  GET filenum%, , wFormatTag%       '2 bytes
  GET filenum%, , nChannels%        '2 bytes
  GET filenum%, , nSamplesPerSec&   '4 bytes
  GET filenum%, , nAvgBytesPerSec&  '4 bytes
  GET filenum%, , nBlockAlign%      '2 bytes
  GET filenum%, , FormatSpecific%   '2 bytes
  'Read bytes until have read fLen& total bytes.
  'I have no idea what these next bytes are used for (if they even exist).
  FOR i% = 1 TO fLen& - 16          '16 bytes is what we have read in so far
     GET filenum%, , dummy$         'read in 1 byte at a time
  NEXT i%
  GET filenum%, , dat$
  IF UCASE$(dat$) = "FACT" THEN
     'funny format...
     GET filenum%, , dummy&
     GET filenum%, , dummy&
     GET filenum%, , dat$
  END IF
  GET filenum%, , dataLen&
  LenHeader% = LOC(1)
CLOSE filenum%
'  PRINT rID$;
'  PRINT rLen&;
'  PRINT wID$;
'  PRINT fID$;
'  PRINT fLen&;
'  PRINT wFormatTag%;       '2 bytes
'  PRINT nChannels%;        '2 bytes
'  PRINT nSamplesPerSec&;   '4 bytes
'  PRINT nAvgBytesPerSec&;  '4 bytes
'  PRINT nBlockAlign%;      '2 bytes
'  PRINT FormatSpecific%;   '2 bytes
'  PRINT dat$;
'  PRINT dataLen&;
'  PRINT LenHeader%
IF UCASE$(rID$) = "RIFF" THEN
   IF UCASE$(wID$) = "WAVE" THEN
      IF UCASE$(dat$) = "DATA" THEN
         IF UCASE$(fID$) = "FMT " THEN
           IF FormatSpecific% = 8 THEN ok% = -1
         END IF
      END IF
   END IF
END IF
END SUB

'------------------------------------------------------------------------------
SUB WriteToDSP (v%)
DO
LOOP UNTIL (INP(BlasterAddr% + &HC) AND 128) = 0
OUT BlasterAddr% + &HC, v%
END SUB

rem ****************************
rem * THE SUPER CUBE SIMULATOR *
rem ****************************
rem *    By Hamish McHaggis    *
rem ****************************

cls:sync on:hide mouse:cube_z#=500:size#=300:eye#=600:ink rgb(255,255,255),0:dim x#(4,10):dim y#(4,10):dim z#(4,10):dim sx#(10):dim sy#(10):data 0.0,1.0,1.0,0.0,1.0,-1.0,1.0,1.0,0.0,-1.0,1.0,0.0
data 0.0,-1.0,1.0,0.0,-1.0,-1.0,1.0,-1.0,0.0,-1.0,-1.0,0.0:for x=1 to 8:read x#(1,x):read y#(1,x):read z#(1,x):next x:do:if upkey()=1:eye#=eye#+1:endif:if downkey()=1 and eye#>1.0:eye#=eye#-1:endif
if leftkey()=1 and size#>1.0:size#=size#-1:endif:if rightkey()=1:size#=size#+1:endif:if inkey$()="x":x_rot#=x_rot#+1:endif:if inkey$()="z":x_rot#=x_rot#-1:endif:if inkey$()="s":y_rot#=y_rot#+1:endif
if inkey$()="a":y_rot#=y_rot#-1:endif:if inkey$()="w":z_rot#=z_rot#+1:endif:if inkey$()="q":z_rot#=z_rot#-1:endif:rot1#=wrapvalue(rot1#+y_rot#/10):rot2#=wrapvalue(rot2#+x_rot#/10):rot3#=wrapvalue(rot3#+z_rot#/10)
for l=1 to 8:x#(2,l)=(cos(rot1#)*x#(1,l)-sin(rot1#)*z#(1,l)):y#(2,l)=y#(1,l)/3*2:z#(2,l)=(sin(rot1#)*x#(1,l)+cos(rot1#)*z#(1,l)):x#(3,l)=x#(2,l):y#(3,l)=(cos(rot2#)*y#(2,l)-sin(rot2#)*z#(2,l)):z#(3,l)=(sin(rot2#)*y#(2,l)+cos(rot2#)*z#(2,l))
x#(4,l)=(cos(rot3#)*x#(3,l)-sin(rot3#)*y#(3,l))*size#:y#(4,l)=(sin(rot3#)*x#(3,l)+cos(rot3#)*y#(3,l))*size#:z#(4,l)=z#(3,l)*size#:sx#(l)=320+x#(4,l)/((z#(4,l)+cube_z#+eye#)/eye#):sy#(l)=240-y#(4,l)/((z#(4,l)+cube_z#+eye#)/eye#)
next l:ink rgb(255,255,255),0:for x=1 to 4:line sx#(x),sy#(x),sx#(x+4),sy#(x+4):next x:for x=0 to 1:for y=1 to 2:line sx#(y+4*x),sy#(y+4*x),sx#(y+2+4*x),sy#(y+2+4*x):line sx#(y+4*x),sy#(y+4*x),sx#((5-y)+4*x),sy#((5-y)+4*x):next y:next x
center text 320,10,"THE SUPER CUBE SIMULATOR v1.0":text 20,20,"View Point: "+str$(eye#):text 20,40,"Cube Size: "+str$(size#):text 20,60,"Rotation Rate    X: "+str$(x_rot#/10)+"   Y: "+str$(y_rot#/10)+"   Z: "+str$(z_rot#/10:sync:cls:loop