'===========================================================================
' Subject: FAST JPEG VIEWER FOR SVGA         Date: 12-24-99 (15:48)       
' Author:  Antoni Gual                       Code: QB, PDS                
' Origin:  agual@eic.ictnet.es             Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB svgappgrey (x%, y%, lum%)
DECLARE SUB SVGAGetData ()
DECLARE FUNCTION SVGASelectMode% ()
DECLARE SUB SVGAPPixel (x%, y%, r%, g%, b%)
DECLARE SUB JPEGViewParms ()
DECLARE FUNCTION NxtBit% ()
DECLARE SUB JPEGGetParms (jfile%)
DECLARE FUNCTION filesel$ (prompt$, match%, ext$)
DECLARE SUB JPEGGet8x8 (vector%(), HuffDcNum%, HuffACNum%, quantNum%, dcCoef%, viw%)
DECLARE SUB SelectVGAMode (rb%, gg%)
DECLARE FUNCTION JPEGGetByte% ()
DECLARE FUNCTION SVGASetMode% (MODE%)
DECLARE SUB SVGAPrint (cad$, x%, y%, r%, g%, b%)
DECLARE SUB JPEGPut (jfile%, x0%, y0%)

'............................................................................
'FAST! JPEG Viewer for SVGA  by Antoni Gual
'
'Original program by Dmitry Brant
'
'IMPORTANT:
'  -This program will run only if you have a SVGA card VESA compatible with at
'   least 0.5 Mb memory.
'  -Some resolutions available in your video card could need scan fequencies
'   out of the range of your monitor. Try using uour card's software to reduce
'   the refresh frequency of the image.
'  -Some old cards are VESA 1.0 compatible. They use propietary hicolor modes
'   different than standard VESA 1.2 and 2, so the colors displayed could not
'   be very real. In these cases you could try the 8 pixel modes..

'The ABC packets give me oportunity of learning about new issues in programming
'by analyzing the work of other people.
'When the issue is as complicated as is the JPG format, the snippets must be
'exceptionally well coded and self-explaining, as Dmitry's was.Thanks, Dmitry!
'Well, to get rid of the bugs I've created, I also had to read a lot of
'format specs for JPEG found in www.wotsit.com...

'Why I send a recoding of the same program? Well, here are the features:
'
'- No libraries, only interrupt calls. Not a line of assembler!.
'  It can be run in QBasic, if previously source is processed
'  with the interrupt translator by Mark Andryk (in INTERRUPT.ABC).
'
'- Auto detects suitable SVGA modes.
'  As most SVGA cards achieve their higher resolutions using 8 bits/pixel and
'  a palette (as Mode 13), these modes are available.
'  In these modes, the user has two options, display black/ and white or
'  approximative color.
'
'- Displays color in  all 15,16,24 and 32 bits direct color VESA modes.
'
'- Uses 8bits modes to display fast the monochrome images or aproximative color.
'
'- Displays the JPEG file parameters.
'
'- "User friendly" file selection. The same old routine...
'
'- Auto-centers the image, even if thatïs bigger than the chosen screen.
'
'- The parts of the image not displayed are skipped fast.
'
'- Is 10 times faster than the original program!
' I achieved a x3 increase of speed using the usual optimization techniques..
' I saw the program spent a 80% of his time calculating the DCT, so I
' implemented the Loeffler-Ligtenbert-Moschytz algorythm I found in the Net
' (I simply translated from Pascal, I was unable to find the theory behind it.)
' There's another algorythm still faster, the Arai-Agui-Nakajima that could
' improve the speed a further 20%...
' After it I've substituted the ASM VESA library of the original proogram
' with BAsic routines, so I lost a 20%-30% in speed.
' The program, when compiled, is still 5 times slower than Paint Shop Pro 4.
' I think one of the main reasons is the lack of bit shift instructions
' in QB.
'............................................................................
' If you want to make it faster:
' Time spent in each phase:
'  -44%  getting data from file and doing Huffman decoding
'  -30%  calculating IDCT's
'  -20%  putting pixels on SVGA screen
'  - 6%  in the main JPEGPut (generation of color components, interlacing)
'
'  -Implement the Arai-Agui-Nakajima inverse DCT
'  -Translate it to PowerBasic or to Turbo Pascal ;)
'
'............................................................................
'Enjoy,and tell me about!
'
'Antoni agual@eic.ictnet.es
'
'.............................................................................


'$INCLUDE: 'qb.bi'

DEFINT A-Z
CONST TOTALBUF = 2000
CONST dc = 0, AC = 1

CONST VESAOK = &H4F
TYPE vesainfoblock
	VESASignature AS STRING * 4
	VESAVersion AS INTEGER
	OEMStringPtr AS LONG
	Capabilities AS STRING * 4
	VIDEOMODEPTR AS LONG
	TotalMemory AS INTEGER
	Reserved AS STRING * 236
'we manage this  part
	modeord AS INTEGER
	modemax AS INTEGER
	bytespixel AS INTEGER
	Xres AS INTEGER
	yres AS INTEGER
	bytesrow AS LONG
	bpp AS INTEGER
	winsize AS LONG
	winseg AS INTEGER
	bw AS INTEGER
END TYPE

TYPE vesaModeinfoBlock
	Modeattributes AS INTEGER
	WinAAttributes AS STRING * 1
	WinBAttributes AS STRING * 1
	WinGranularity AS INTEGER
	winsize AS INTEGER
	winAsegment AS INTEGER
	WinBSegment AS INTEGER
	WinFuncPtr AS LONG
	Bytesperscanline AS INTEGER
	Xres AS INTEGER
	yres AS INTEGER
	XCharSize AS STRING * 1
	YCharSize AS STRING * 1
	NumberOfPlanes AS STRING * 1
	bpp AS STRING * 1
	NumberOfBanks AS STRING * 1
	MemoryModel AS STRING * 1
	BankSize AS STRING * 1
	NumPages AS STRING * 1
	Rsvd AS STRING * 1
	RedMaskSize AS STRING * 1
	RedFieldPosition AS STRING * 1
	GreenMaskSize AS STRING * 1
	GreenFieldPosition AS STRING * 1
	BlueMaskSize AS STRING * 1
	BlueFieldPosition AS STRING * 1
	RsvdMaskSize AS STRING * 1
	DirectColorModeInfo AS STRING * 1
	Reserved AS STRING * 216
	'we manage this part
	MODENUM AS INTEGER
	order AS INTEGER
END TYPE




TYPE JpegType             'some type definitions (for coherence)
  jfifmajor AS STRING * 1
  jfifMinor AS STRING * 1
  densunits AS STRING * 1
  Xdens AS INTEGER
  ydens AS INTEGER
  ThWidth AS STRING * 1
  Theigth AS STRING * 1
  rows AS INTEGER 'image height
  cols AS INTEGER 'image width
  samplesy AS INTEGER 'sampling ratios
  samplescbcr AS INTEGER
  qty AS INTEGER  'quantization table numbers
  qtcbr AS INTEGER
  HDCTY AS INTEGER 'huffman table numbers
  HDCTCBR AS INTEGER
  HaCTY AS INTEGER
  HaCTCBR AS INTEGER
  numcomp AS INTEGER  'number of components
  restart AS INTEGER
END TYPE

TYPE HuffmanEntry 'a type for huffman tables
  Index AS INTEGER
  Code AS INTEGER
  Length AS INTEGER
END TYPE

TYPE zigzagtype
 xp AS INTEGER
 yp AS INTEGER
END TYPE

'a few global variables

DIM SHARED curByte, curbits, jfile
DIM buf$, ptr, endptr, find$: find$ = CHR$(255) + CHR$(0)

REDIM SHARED display(0) AS vesaModeinfoBlock
DIM SHARED vesainfo AS vesainfoblock
DIM SHARED regs AS RegTypeX
DIM SHARED image AS JpegType
DIM SHARED imgcomment$
DIM SHARED HuffTbl(0 TO 1, 0 TO 1, 0 TO 255) AS HuffmanEntry
DIM SHARED quant(0 TO 1, 0 TO 7, 0 TO 7) '2 quantization tables (Y, CbCr)
DIM SHARED errata, sg, of

'-------------------init tables

'*** typical 2^ table...
DIM SHARED pwrsof2(-1 TO 15), bit1(-1 TO 15)' AS LONG:
RESTORE BITS
FOR i = -1 TO 15: READ pwrsof2(i)
IF i = 15 THEN EXIT FOR
bit1(i) = (NOT (pwrsof2(i) - 1) - 1): NEXT
bit1(15) = &H8001

'*** program gets zigzag values from an array, faster than read it each time
DIM SHARED zz(0 TO 63) AS zigzagtype
RESTORE zig2: FOR i = 0 TO 63: READ zz(i).xp, zz(i).yp: NEXT

'locate charmap in bios (SVGAPrint)
  regs.AX = &H1130
  regs.bx = 6 * 256
  CALL INTERRUPTX(&H10, regs, regs)
  sg = regs.ES
  of = regs.bp


'--------- A demonstration ----------

SCREEN 0: CLS
SVGAGetData

DO
  
  SCREEN 7: WIDTH 80, 50: CLS
  f$ = filesel("Select a JPEG file to view", 1, "jpg")
  jfile = 1
  OPEN f$ FOR BINARY AS #jfile
  endptr = TOTALBUF: buf$ = SPACE$(endptr): ptr = endptr + 1
  JPEGGetParms jfile
  JPEGViewParms
  a$ = UCASE$(INKEY$)
  IF a$ = "Y" THEN
	  SCREEN 0: WIDTH , 50: CLS
	  fail = SVGASelectMode
	  
	  y0 = ((display(vesainfo.modeord).yres - image.rows) \ 16) * 8
	  x0 = ((display(vesainfo.modeord).Xres - image.cols) \ 16) * 8
	  IF y0 < 0 THEN
		  SVGAPrint "The centered image is bigger than the screen", 16, 0, 255, 255, 255
		  SVGAPrint "JPEG images must be decoded from the beggining", 32, 0, 255, 255, 255
		  SVGAPrint "Be patient until image starts to show.", 48, 0, 255, 255, 255
		  SVGAPrint "Please wait....or press Escape to exit.", 64, 0, 255, 255, 255
	  END IF
	  time! = TIMER
	  JPEGPut jfile, x0, y0
	  CLOSE #jfile
	  time! = TIMER - time!
	  BEEP: r$ = INPUT$(1)
	  SVGAPrint "Time: " + STR$(time!) + " sec.", 90, 0, 255, 255, 255
	  DO: r$ = INKEY$: LOOP UNTIL LEN(r$)
	  a = SVGASetMode(3)
	  
  ELSE
	  CLOSE #jfile
  END IF
  SCREEN 0, , 0, 0: WIDTH , 50
  CLS : LOCATE 25, 1: PRINT "Another File? [Y/N].."
  r$ = UCASE$(INPUT$(1))
  
LOOP UNTIL r$ = "N"
END
'--------- End of Demo ----------

'error handlers

FileSelError: errata = ERR: RESUME NEXT


ANYERROR: SCREEN 7: CLS : CLOSE : RESUME

JPEGGetErrors:
  SCREEN 7: CLS
  CLOSE
  SELECT CASE ERR
  CASE 99: PRINT "Not a Valid JPEG/JFIF file"
  CASE 100: PRINT "Only 8x8 samples supported"
  CASE 101: PRINT "Arithmetic coding not supported"
  CASE 102: PRINT "End of Image Found"
  CASE 103: PRINT "Error Getting SoS marker"
  CASE 104: PRINT "Unexpected file format"
  CASE 105: PRINT "16 bits Quantization tables not supported"
  CASE 106: PRINT "Not a JFIF format"
  CASE ELSE: PRINT "Error "; ERR; "While getting JPEG parameters"
  END SELECT
END


'------------data------------------

BITS:
DATA 0,1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32768


zig2:  'Zigzag patterns for reordering quantization tables and vectors
DATA 0,0
ZigzagPositions:
DATA 0,1,1,0
DATA 2,0,1,1,0,2
DATA 0,3,1,2,2,1,3,0
DATA 4,0,3,1,2,2,1,3,0,4
DATA 0,5,1,4,2,3,3,2,4,1,5,0
DATA 6,0,5,1,4,2,3,3,2,4,1,5,0,6
DATA 0,7,1,6,2,5,3,4,4,3,5,2,6,1,7,0
DATA 7,1,6,2,5,3,4,4,3,5,2,6,1,7
DATA 2,7,3,6,4,5,5,4,6,3,7,2
DATA 7,3,6,4,5,5,4,6,3,7
DATA 4,7,5,6,6,5,7,4
DATA 7,5,6,6,5,7
DATA 6,7,7,6
DATA 7,7

FUNCTION filesel$ (prompt$, match%, ext$) 'User friendly file selector
'............................................................................
'SELF-CONTAINED FILE SELECTOR FUNCTION by Antoni Gual (agual@eic.ictnet.es)
'
'params: prompt$>> the prompt ttat is displayed
'        match% >> on input: 1=> filename must exist  0=> must not exist
'                  on output:1=> filename does exist  0=> does not exist
'        ext$   >> default extension
'
'--to use it copy this function to your program
'--add:
'
'       '$INCLUDE 'QB.BI'
'       DIM SHARED errata as INTEGER
'
'--AT THE START OF YOUR PROGRAM AND
'
'       FileSelError:errata=err:resume next
'
'--AFTER THE END OF THE  MAIN  PROGRAM
'WARNING: This function changes the default dir to where the file is.
'............................................................................
	'error messages
	CONST pak$ = ". Press a key.."
	CONST pnf$ = "Path not Found"
	CONST ddne$ = "Drive does not Exist"
	CONST dnr$ = "Drive not ready. [Retry/Abort]"
	CONST fdne$ = "File not found"
	CONST ifn$ = "Invalid File Name"
	CONST idn$ = "Invalid Drive Name"
	CONST pfe$ = "Path-file error"
	ff$ = ""
	filnum = FREEFILE
	'screen reset, start error handler
	VIEW PRINT: COLOR 7, 0: CLS
	ON ERROR GOTO FileSelError
	GOSUB viewfiles: GOTO askname

	DO
		GOSUB viewfiles
		'
		'UNCOMMENT NEXT LINE IF YOU DON'T HAVE interruptx ACCESS!!
		'GOTO ASKPATH
		'
askdrive:
		COLOR 15, 4: CLS
		GOSUB question: INPUT "Drive [Enter:Current]>", drive$
		'if no input, go ask path
		IF LEN(drive$) THEN
R3:     IF LEN(drive$) > 2 THEN ERROR 64: GOTO BADDRIVE
			DRIV% = ASC(UCASE$(drive$)) - 65
			IF DRIV% < 0 OR DRIV% > 23 THEN ERROR 64: GOTO BADDRIVE
			regs.AX = &HE00: regs.dx = DRIV%
			CALL INTERRUPTX(&H21, regs, regs)
			'probably the drive we asked for does'nt exist
			regs.AX = &H1900
			CALL INTERRUPTX(&H21, regs, regs)
			IF (regs.AX AND &HFF) <> DRIV% THEN ERROR 68
BADDRIVE:   SELECT CASE errata
			CASE 64:
				msgerr$ = idn$ + pak$: GOSUB errmsg: GOTO askdrive
			CASE 68: msgerr$ = ddne$ + pak$: GOSUB errmsg: GOTO askdrive
			CASE 71: msgerr$ = dnr$: GOSUB errmsg: IF a$ = "R" THEN GOTO R3 ELSE GOTO askdrive
			END SELECT
			GOSUB viewfiles
		END IF

askpath:
		'what is in?  Here we trap the no disk error
		COLOR 14, 4: CLS
R4:     IF errata = 71 THEN msgerr$ = dnr$: GOSUB errmsg: IF a$ = "R" THEN GOTO R4 ELSE GOTO askdrive
		GOSUB question: INPUT "Path [Enter:Current]>", path$
		'if no input go ask filename
		IF LEN(path$) THEN
r1:         CHDIR path$
			IF errata = 53 OR errata = 76 THEN msgerr$ = pnf$ + pak$: GOSUB errmsg: GOTO askpath
			IF errata = 71 THEN msgerr$ = dnr$: GOSUB errmsg: IF a$ = "R" THEN GOTO r1 ELSE GOTO askdrive
			GOSUB viewfiles
		END IF
askname:
		COLOR 7, 4: CLS
		GOSUB question: INPUT "File [Enter:New path]>", name$
		IF LEN(name$) = 0 GOTO r6
		IF LEN(ext$) THEN
			temp = INSTR(name$, ".")
			IF temp THEN
				name$ = LEFT$(name$, temp - 1) + "." + ext$
			ELSE
				name$ = name$ + "." + ext$
			END IF
		END IF
		'does it exist?
R2:     OPEN name$ FOR INPUT AS #filnum
		SELECT CASE errata
		CASE 76: msgerr$ = pnf$ + pak$: GOSUB errmsg: GOTO askname
		CASE 53:
			IF match = 1 THEN
				LOCATE 2, 1: msgerr$ = fdne + pak$: GOSUB errmsg: GOTO askname
			ELSE
				ff$ = " NOT ": GOTO outofthere
			END IF
		CASE 64: LOCATE 2, 1: msgerr$ = ifn$ + pak$: GOSUB errmsg: GOTO askname
		CASE 71: msgerr$ = dnr$: GOSUB errmsg: IF a$ = "R" THEN GOTO R2 ELSE GOTO askdrive
		CASE 75: msgerr$ = pfe$ + pak$: GOSUB errmsg: GOTO askname
		END SELECT
r5:     CLOSE #filnum
r6:
	LOOP UNTIL LEN(name$)

outofthere:
	'file exists: return
	msgerr$ = "File " + UCASE$(name$) + ff$ + " found.." + pak$: GOSUB errmsg
	VIEW PRINT: COLOR 7, 0: CLS
	IF LEN(ff$) THEN match% = 0 ELSE match = 1
	filesel$ = name$
	ON ERROR GOTO 0
EXIT FUNCTION

viewfiles:
	VIEW PRINT 3 TO 25: COLOR 7, 0: CLS :
	'IF LEN(ext$) THEN a$ = "*." + ext$ ELSE a$ = ""
	FILES 'a$
	VIEW PRINT 1 TO 2:
RETURN

question:
	LOCATE 1, 1: PRINT SPACE$(80): LOCATE 1, 1: PRINT prompt$ + "? -->Select ";
RETURN

errmsg:
	LOCATE 2, 1: PRINT msgerr$: a$ = UCASE$(INPUT$(1)): LOCATE 2, 1: PRINT SPACE$(80)
	errata = 0
RETURN

END FUNCTION

SUB ideas
' arreglar bug: a veces no empieza la imagen en su sitio
' arreglar bug: los REDIM de Get8X8 no son aceptados por QBasic
' arreglar bug. Texto timer a veces no sale en su sitio
' arreglar bug: por qu‚ color 255,255,255 de letras es amarillo y no blanco?

' eliminar array de resoluciones VESA,ocupa espacio in£tilmente
' al proponer resoluciones, separar las de true/hicolor de las de paleta
' probar en 8 bits un color de 6*7*6, a ver si es mas real
' decodificar a temporal y presentar imagen en pantalla con zoom y encuadre
' funciona el rat¢n en VESA?
' a¤adir gif ,tiff, pcx, bmp. de otros autores!
END SUB

SUB JPEGGet8x8 (vector(), HuffDcNum, HuffACNum, quantNum, dcCoef, viw) STATIC
'reads file ,decodes, and returns a 8x8 block of a component (Y, Cb or cr)
'erase arrays
CONST FIX029 = 2446&
CONST FIX039 = 3196&
CONST FIX054 = 4433&
CONST FIX076 = 6270&
CONST FIX089 = 7373&
CONST FIX117 = 9633&
CONST FIX150 = 12299&
CONST FIX184 = 15137&
CONST FIX196 = 16069&
CONST FIX205 = 16819&
CONST FIX256 = 20995&
CONST FIX307 = 25172&
CONST constbits = 13
CONST PASS1BITS = 1
REDIM vector(0 TO 7, 0 TO 7)
DIM z1 AS LONG, z2 AS LONG, z3 AS LONG, z4 AS LONG, z5 AS LONG
DIM tmp0 AS LONG, tmp1 AS LONG, tmp2 AS LONG, tmp3 AS LONG, tmp4 AS LONG
DIM tmp5 AS LONG, tmp6 AS LONG, tmp7 AS LONG, tmp8 AS LONG, tmp9 AS LONG
DIM tmp10 AS LONG, tmp11 AS LONG, tmp12 AS LONG, tmp13 AS LONG
'GOTO dct 'test only
'Get the DC coefficient
hnum = HuffDcNum: tk = 0: GOSUB dekode1
cat = dekode: GOSUB getnbits1: dcCoef = dcCoef + getnbits
vector(0, 0) = dcCoef

'Get AC Coefficients
K = 1: hnum = HuffACNum: tk = 1
DO
  GOSUB dekode1
  SELECT CASE dekode
  CASE 0 'EOB Encountered
  EXIT DO
  CASE 3270 'ZRL encountered  15*256+0
  K = K + 16
  CASE ELSE
  K = K + dekode \ 16
  cat = dekode AND 15: GOSUB getnbits1
  'zigzag!
  vector(zz(K).xp, zz(K).yp) = getnbits
  K = K + 1
  END SELECT
LOOP UNTIL K > 63

'end of file reading, the next section can be skipped if this block is not to
'be displayed!
'EXIT SUB  'test only
dct:
IF NOT viw THEN EXIT SUB


x1& = 8& * pwrsof2(constbits + PASS1BITS)
x2& = pwrsof2(constbits)
x = pwrsof2(constbits - PASS1BITS)
FOR u = 7 TO 0 STEP -1
  
	
	IF (vector(1, u) OR vector(2, u) OR vector(3, u) OR vector(4, u) OR vector(5, u) OR vector(6, u) OR vector(7, u)) = 0 THEN
	  dcval& = vector(0, u) * quant(quantNum, 0, u) * pwrsof2(PASS1BITS)
	  vector(0, u) = dcval&
	  vector(1, u) = dcval&
	  vector(2, u) = dcval&
	  vector(3, u) = dcval&
	  vector(4, u) = dcval&
	  vector(5, u) = dcval&
	  vector(6, u) = dcval&
	  vector(7, u) = dcval&
	
	ELSE
   ' { Even part: reverse the even part of the forward DCT. }
	'{ The rotator is sqrt(2)*c(-6). }

	z2 = vector(2, u) * quant(quantNum, 2, u)
	z3 = vector(6, u) * quant(quantNum, 6, u)

	z1 = (z2 + z3) * FIX054
	tmp2 = z1 + (z3 * -FIX184)
	tmp3 = z1 + (z2 * FIX076)
	z2 = vector(0, u) * quant(quantNum, 0, u)
	z3 = vector(4, u) * quant(quantNum, 4, u)

	tmp0 = x2& * (z2 + z3)
	tmp1 = x2& * (z2 - z3)

	tmp10 = tmp0 + tmp3
	tmp13 = tmp0 - tmp3
	tmp11 = tmp1 + tmp2
	tmp12 = tmp1 - tmp2

'    { Odd part per figure 8; the matrix is unitary and hence its
'      transpose is its inverse.  i0..i3 are y7,y5,y3,y1 respectively. }

	tmp0 = vector(7, u) * quant(quantNum, 7, u)
	tmp1 = vector(5, u) * quant(quantNum, 5, u)
	tmp2 = vector(3, u) * quant(quantNum, 3, u)
	tmp3 = vector(1, u) * quant(quantNum, 1, u)

	z1 = tmp0 + tmp3
	z2 = tmp1 + tmp2
	z3 = tmp0 + tmp2
	z4 = tmp1 + tmp3
	z5 = (z3 + z4) * FIX117
	tmp0 = tmp0 * FIX029                  ' { sqrt(2) * (-c1+c3+c5-c7) }
	tmp1 = tmp1 * FIX205                  ' { sqrt(2) * ( c1+c3-c5+c7) }
	tmp2 = tmp2 * FIX307                  '; { sqrt(2) * ( c1+c3+c5-c7) }
	tmp3 = tmp3 * FIX150                  '; { sqrt(2) * ( c1+c3-c5-c7) }
	z1 = z1 * -FIX089  ' ; { sqrt(2) * (c7-c3) }
	z2 = z2 * -FIX256  ' { sqrt(2) * (-c1-c3) }
	z3 = z3 * -FIX196  ' { sqrt(2) * (-c3-c5) }
	z4 = z4 * -FIX039  ' { sqrt(2) * (c5-c3) }
	z3 = z3 + z5
	z4 = z4 + z5

	tmp0 = tmp0 + z1 + z3
	tmp1 = tmp1 + z2 + z4
	tmp2 = tmp2 + z2 + z3
	tmp3 = tmp3 + z1 + z4

   ' { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }

	
	vector(0, u) = (tmp10 + tmp3) \ x
	vector(7, u) = (tmp10 - tmp3) \ x
	vector(1, u) = (tmp11 + tmp2) \ x
	vector(6, u) = (tmp11 - tmp2) \ x
	vector(2, u) = (tmp12 + tmp1) \ x
	vector(5, u) = (tmp12 - tmp1) \ x
	vector(3, u) = (tmp13 + tmp0) \ x
	vector(4, u) = (tmp13 - tmp0) \ x

 END IF
NEXT
'  { Pass 2: process rows from work array, store into output array. }
'  { Note that we must descale the results by a factor of 8 == 2**3, }
'  { and also undo the PASS1

FOR v = 0 TO 7

'    { Even part: reverse the even part of the forward DCT. }
'   { The rotator is sqrt(2)*c(-6). }

	z2 = vector(v, 2)
	z3 = vector(v, 6)

	z1 = (z2 + z3) * FIX054
	tmp2 = z1 + (z3 * -FIX184)
	tmp3 = z1 + (z2 * FIX076)
	tmp0 = x2& * (vector(v, 0) + vector(v, 4))
	tmp1 = x2& * (vector(v, 0) - vector(v, 4))

	tmp10 = tmp0 + tmp3
	tmp13 = tmp0 - tmp3
	tmp11 = tmp1 + tmp2
	tmp12 = tmp1 - tmp2

	'{ Odd part per figure 8; the matrix is unitary and hence its
	'  transpose is its inverse.  i0..i3 are y7,y5,y3,y1 respectively. }

	tmp0 = vector(v, 7)
	tmp1 = vector(v, 5)
	tmp2 = vector(v, 3)
	tmp3 = vector(v, 1)

	z1 = tmp0 + tmp3
	z2 = tmp1 + tmp2
	z3 = tmp0 + tmp2
	z4 = tmp1 + tmp3
	z5 = (z3 + z4) * FIX117
	tmp0 = tmp0 * FIX029
	tmp1 = tmp1 * FIX205' { sqrt(2) * ( c1+c3-c5+c7) }
	tmp2 = tmp2 * FIX307
	tmp3 = tmp3 * FIX150' { sqrt(2) * ( c1+c3-c5-c7) }
	z1 = z1 * -FIX089
	z2 = z2 * -FIX256 '; { sqrt(2) * (-c1-c3) }
	z3 = z3 * -FIX196
	z4 = z4 * -FIX039 ' ; { sqrt(2) * (c5-c3) }
	z3 = z3 + z5
	z4 = z4 + z5

	tmp0 = tmp0 + z1 + z3
	tmp1 = tmp1 + z2 + z4
	tmp2 = tmp2 + z2 + z3
	tmp3 = tmp3 + z1 + z4

	'{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
	
	vector(v, 0) = (tmp10 + tmp3) \ x1&
	vector(v, 7) = (tmp10 - tmp3) \ x1&
	vector(v, 1) = (tmp11 + tmp2) \ x1&
	vector(v, 6) = (tmp11 - tmp2) \ x1&
	vector(v, 2) = (tmp12 + tmp1) \ x1&
	vector(v, 5) = (tmp12 - tmp1) \ x1&
	vector(v, 3) = (tmp13 + tmp0) \ x1&
	vector(v, 4) = (tmp13 - tmp0) \ x1&
NEXT

EXIT SUB


'--------------subroutines-------------------------

dekode1:
curVal = 0
mf = -1: i = 0
FOR l = 1 TO 16  'cycle through 16 possible Huffman lengths
  GOSUB nextbit1: IF nextbit THEN curVal = curVal OR pwrsof2(16 - l)
  DO UNTIL i > 255 'look for a match in the Huffman table
	  IF HuffTbl(tk, hnum, i).Length > l THEN EXIT DO
	  IF HuffTbl(tk, hnum, i).Index = curVal THEN mf = i: EXIT DO
	  i = i + 1
  LOOP
  IF mf > -1 THEN EXIT FOR
NEXT l
IF i = 256 THEN ERROR 110
dekode = HuffTbl(tk, hnum, mf).Code 'return the appropriate code
RETURN

getnbits1:
temp0 = 0: c1 = cat - 1
FOR i = c1 TO 0 STEP -1: GOSUB nextbit1: IF nextbit THEN temp0 = temp0 OR pwrsof2(i)
NEXT
IF temp0 AND pwrsof2(c1) THEN getnbits = temp0 ELSE getnbits = bit1(cat) + temp0
RETURN

nextbit1:
IF curbits < 0 THEN curbits = 7: curByte = JPEGGetByte
nextbit = curByte AND pwrsof2(curbits)
curbits = curbits - 1
RETURN

END SUB

FUNCTION JPEGGetByte STATIC
'***buffered, all file access goes thru it
'gets a single byte from file. At reading, it converts the pairs FF 00 to 00's

SHARED buf$, ptr, endptr, find$
IF ptr > endptr THEN
  GET #jfile, , buf$: ptr = SADD(buf$): endptr = TOTALBUF + ptr - 1
  i0 = INSTR(buf$, find$)
  IF PEEK(endptr) = 255 THEN endptr = endptr - 1: SEEK #jfile, SEEK(jfile) - 1
  DO WHILE i0 > 0 AND i0 < endptr
	  MID$(buf$, i0 + 1) = MID$(buf$, i0 + 2): endptr = endptr - 1
	  i0 = INSTR(i0 + 1, buf$, find$)
  LOOP
END IF
JPEGGetByte = PEEK(ptr): ptr = ptr + 1
END FUNCTION

SUB JPEGGetParms (jfile)
DIM HuffAmount(1 TO 16)
DIM GETword AS LONG
'ON ERROR GOTO JPEGGetErrors
QTables = 0 'Initialize some checkpoint variables
ACTables = 0
dctables = 0
image.restart = GETword
SEEK jfile, 1
GOSUB getword1
IF GETword <> 65496 THEN ERROR 99
DO  'Primary control loop for markers
  IF JPEGGetByte = 255 THEN 'Marker Found
	  d = JPEGGetByte
	  SELECT CASE d 'which one is it?
	  CASE &HC0, &HC1  'SOF0
		  'get image attributes
		  GOSUB getword1:
		  temp4& = GETword              'Length of segment
		  temp0 = JPEGGetByte           'Data precision
		  IF temp0 <> 8 THEN ERROR 100  'we do not support 12 or 16-bit samples
		  GOSUB getword1: image.rows = GETword:
		  GOSUB getword1: image.cols = GETword:
		  temp0 = JPEGGetByte           'Number of components
		  FOR i = 1 TO temp0
			  id = JPEGGetByte
			  SELECT CASE id
			  CASE 1
				  temp1 = JPEGGetByte
				  image.samplesy = (temp1 AND 15) * (temp1 \ 16)
				  image.qty = JPEGGetByte
			  CASE 2, 3
				  temp1 = JPEGGetByte
				  image.samplescbcr = (temp1 AND 15) * (temp1 \ 16)
				  image.qtcbr = JPEGGetByte
			  END SELECT
		  NEXT i
	  CASE &HC9 'SOF9
		ERROR 101
	  CASE &HC4 'DHT
		  IF ACTables < 2 OR dctables < 2 THEN
			  'get huffman tables
			  GOSUB getword1
			  l0 = GETword
			  c0 = 2
			  DO
				  temp0 = JPEGGetByte: c0 = c0 + 1
				  t0 = (temp0 AND 16) \ 16
				  temp0 = temp0 AND 15
				  total = 0
				  FOR i = 1 TO 16
					  temp1 = JPEGGetByte: c0 = c0 + 1
					  total = total + temp1
					  HuffAmount(i) = temp1
				  NEXT i
				  FOR i = 0 TO total - 1
					HuffTbl(t0, temp0, i).Code = JPEGGetByte: c0 = c0 + 1
				  NEXT i
				  curnum& = 0
				  curIndex = -1
				  FOR i = 1 TO 16
					  FOR j = 1 TO HuffAmount(i)
						  curIndex = curIndex + 1
						  tmp& = curnum& * pwrsof2(16 - i)
						  IF tmp& < 32768 THEN
							HuffTbl(t0, temp0, curIndex).Index = tmp&
						  ELSE
							HuffTbl(t0, temp0, curIndex).Index = tmp& - 65536
						  END IF
						  HuffTbl(t0, temp0, curIndex).Length = i
						  curnum& = curnum& + 1
					  NEXT j
					  curnum& = curnum& * 2
				  NEXT i
				  IF t0 THEN ACTables = ACTables + 1 ELSE dctables = dctables + 1
			  LOOP UNTIL c0 >= l0
		  END IF
	  CASE &HCC 'DAC
		ERROR 101
	  CASE &HD8 'SOI
	  CASE &HD9 'EOI
		ERROR 102
	  CASE &HDA 'SOS
		  'get SOS
		  GOSUB getword1
		  temp4& = GETword
		  temp0 = JPEGGetByte
		  IF temp0 <> 1 AND temp0 <> 3 THEN GetSOS = 0: EXIT SUB
		  image.numcomp = temp0
		  FOR i = 1 TO temp0
			  temp1 = JPEGGetByte
			  SELECT CASE temp1
			  CASE 1
				  temp2 = JPEGGetByte
				  image.HaCTY = temp2 AND 15
				  image.HDCTY = temp2 \ 16
			  CASE 2, 3
				  temp2 = JPEGGetByte
				  image.HaCTCBR = temp2 AND 15
				  image.HDCTCBR = temp2 \ 16
			  CASE ELSE
				ERROR 103
			  END SELECT
		  NEXT i
		  num = 3: GOSUB getstring
		  IF (dctables = 2 AND ACTables = 2 AND QTables = 2) OR image.numcomp = 1 THEN
			ON ERROR GOTO 0: EXIT SUB   'Go on to secondary control loop
		  ELSE
			ERROR 104
		  END IF
	  CASE &HDD 'DRI
		  GOSUB getword1:
		  temp0 = GETword
		  GOSUB getword1
		  image.restart = GETword
	  CASE &HDB 'DQT
		  IF QTables < 2 THEN
			  GOSUB getword1: l0 = GETword
			  c0 = 2
			  DO
				  temp0 = JPEGGetByte: c0 = c0 + 1
				  IF temp0 AND &HF0 THEN ERROR 105
				  temp0 = temp0 AND 15
				  xp = 0: yp = 0
				  FOR i = 0 TO 63
					  quant(temp0, zz(i).xp, zz(i).yp) = JPEGGetByte: c0 = c0 + 1
				  NEXT i
				  QTables = QTables + 1
			  LOOP UNTIL c0 >= l0
		  END IF
	  CASE &HE0 'APP0
		  GOSUB getword1
		  l& = GETword
		  num = 5: GOSUB getstring
		  IF getstr$ <> ("JFIF" + CHR$(0)) THEN ERROR 106
		  image.jfifmajor = CHR$(JPEGGetByte)
		  image.jfifMinor = CHR$(JPEGGetByte)
		  image.densunits = CHR$(JPEGGetByte)
		  image.Xdens = GETword
		  image.ydens = GETword
		  image.ThWidth = CHR$(JPEGGetByte)
		  image.Theigth = CHR$(JPEGGetByte)
	  CASE &HFE 'COM
		  GOSUB getword1: num = GETword - 2:
		  GOSUB getstring: imgcomment$ = getstr$
	  END SELECT
  END IF
  IF LEN(INKEY$) THEN EXIT SUB
LOOP
ON ERROR GOTO 0
EXIT SUB


'------subroutines-------------------

'not intel byte order!!
getword1:
temp9 = JPEGGetByte
GETword = 256& * temp9 OR JPEGGetByte
RETURN

getstring:
getstr$ = SPACE$(num)
FOR i = 1 TO num
 MID$(getstr$, i, 1) = CHR$(JPEGGetByte)
NEXT
RETURN


END SUB

SUB JPEGPut (jfile, x0, y0)
'Routine that decodes the file and puts it into the screen

DIM YVector1(0 TO 7, 0 TO 7)              '4 vectors for Y attribute
DIM YVector2(0 TO 7, 0 TO 7)
DIM YVector3(0 TO 7, 0 TO 7)
DIM YVector4(0 TO 7, 0 TO 7)
DIM CbVector(0 TO 7, 0 TO 7)              '1 vector for Cb attribute
DIM CrVector(0 TO 7, 0 TO 7)              '1 vector for Cr attribute
DIM mcu AS LONG
lastj = -1

'We initialize the dc coefficients as they are accumulative
dcY = 0: dcCb = 0: dcCr = 0

xindex = 0: yindex = 0
curbits = 7: curByte = JPEGGetByte
mcu = 0: lastj = -1

SELECT CASE image.numcomp

'Y-Cb-Cr color image
CASE 3
	SELECT CASE image.samplesy
	CASE 4
		DO
			viw = -1
			xi0 = xindex + x0
			IF xi0 >= vesainfo.Xres THEN
				viw = 0
			ELSEIF xi0 < 0 THEN
				viw = 0
			ELSEIF (yindex + y0) < 0 THEN
				viw = 0
			END IF
			JPEGGet8x8 YVector1(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 YVector2(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 YVector3(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 YVector4(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 CbVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCb, viw
			JPEGGet8x8 CrVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCr, viw
			IF viw THEN
				FOR i = 0 TO 7
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					I2 = i \ 2
					FOR j = 0 TO 7
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector1(i, j) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
					NEXT j
				NEXT i
				FOR i = 0 TO 7
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					I2 = i \ 2
					FOR j = 8 TO 15
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector2(i, j - 8) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
					NEXT j
				NEXT i
				FOR i = 8 TO 15
					I2 = i \ 2
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					FOR j = 0 TO 7
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector3(i - 8, j) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
						   
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
					NEXT j
				NEXT i
				FOR i = 8 TO 15
					I2 = i \ 2
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					FOR j = 8 TO 15
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector4(i - 8, j - 8) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
						   
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
					NEXT j
				NEXT i
			END IF
			mcu = mcu + 1: IF image.restart THEN IF image.restart = mcu THEN GOSUB rstrt
			xindex = xindex + 16
			IF xindex >= image.cols THEN xindex = 0: yindex = yindex + 16
			IF LEN(INKEY$) THEN EXIT DO
		LOOP UNTIL yindex >= image.rows OR yindex + y0 >= vesainfo.yres

	'next case not tested (never found an image with this structure)
	CASE 2
		DO
			viw = -1
			xi0 = xindex + x0
			IF xi0 >= vesainfo.Xres THEN
				viw = 0
			ELSEIF xi0 < 0 THEN
				viw = 0
			ELSEIF (yindex + y0) < 0 THEN
				viw = 0
			END IF
			JPEGGet8x8 YVector1(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 YVector2(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 CbVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCb, viw
			JPEGGet8x8 CrVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCr, viw
			IF viw THEN
				FOR i = 0 TO 7
				yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
				I2 = i \ 2
				FOR j = 0 TO 7
					xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
					y = YVector1(i, j) + 128
					IF vesainfo.bw THEN
						IF y < 0 THEN
							y = 0
						ELSEIF y > 255 THEN
							y = 255
						END IF
					   
						svgappgrey xj + x0, yi + y0, y
					ELSE
						j2 = j \ 2
						GOSUB ToRGB
						SVGAPPixel xj + x0, yi + y0, r, g, b
					END IF
				NEXT j
				NEXT i
				FOR i = 0 TO 7
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					I2 = i \ 2
					FOR j = 8 TO 15
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector2(i, j - 8) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
						   
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
					NEXT j
				NEXT i
			END IF
			mcu = mcu + 1: IF image.restart THEN IF image.restart = mcu THEN GOSUB rstrt
			xindex = xindex + 16
			IF xindex >= image.cols THEN xindex = 0: yindex = yindex + 8
			IF LEN(INKEY$) THEN EXIT DO
		LOOP UNTIL yindex >= image.rows OR yindex + y0 >= vesainfo.yres
 
	CASE 1
		DO
			viw = -1
			xi0 = xindex + x0
			IF xi0 >= vesainfo.Xres THEN
				viw = 0
			ELSEIF xi0 < 0 THEN
				viw = 0
			ELSEIF (yindex + y0) < 0 THEN
				viw = 0
			END IF
			JPEGGet8x8 YVector1(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
			JPEGGet8x8 CbVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCb, viw
			JPEGGet8x8 CrVector(), image.HDCTCBR, image.HaCTCBR, image.qtcbr, dcCr, viw
			IF viw THEN
				FOR i = 0 TO 7
					yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
					I2 = i \ 2
					FOR j = 0 TO 7
						xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
						y = YVector1(i, j) + 128
						IF vesainfo.bw THEN
							IF y < 0 THEN
								y = 0
							ELSEIF y > 255 THEN
								y = 255
							END IF
							svgappgrey xj + x0, yi + y0, y
						ELSE
							j2 = j \ 2
							GOSUB ToRGB
							SVGAPPixel xj + x0, yi + y0, r, g, b
						END IF
						NEXT j
				NEXT i
			END IF
			mcu = mcu + 1: IF image.restart THEN IF image.restart = mcu THEN GOSUB rstrt
			xindex = xindex + 8
			IF xindex >= image.cols THEN xindex = 0: yindex = yindex + 8
			IF LEN(INKEY$) THEN EXIT DO
		LOOP UNTIL yindex >= image.rows OR (yindex + y0) >= vesainfo.yres
	END SELECT

'monochrome image
CASE 1
	DO
		viw = -1
		xi0 = xindex + x0
		IF xi0 >= vesainfo.Xres THEN
			viw = 0
		ELSEIF xi0 < 0 THEN
			viw = 0
		ELSEIF (yindex + y0) < 0 THEN
			viw = 0
		END IF
		JPEGGet8x8 YVector1(), image.HDCTY, image.HaCTY, image.qty, dcY, viw
		IF viw THEN
		FOR i = 0 TO 7
			yi = yindex + i: IF yi >= image.rows THEN EXIT FOR
			FOR j = 0 TO 7
				xj = xindex + j: IF xj >= image.cols THEN EXIT FOR
				y = YVector1(i, j) + 128
				IF y < 0 THEN
					y = 0
				ELSEIF y > 255 THEN
					y = 255
				END IF
				svgappgrey xj + x0, yi + y0, y
			NEXT j
		NEXT i
		END IF
		mcu = mcu + 1: IF image.restart THEN IF image.restart = mcu THEN GOSUB rstrt
		xindex = xindex + 8
		IF xindex >= image.cols THEN xindex = 0: yindex = yindex + 8
		IF LEN(INKEY$) THEN EXIT DO
	LOOP UNTIL yindex >= image.rows OR yindex + y0 >= vesainfo.yres
END SELECT
ON ERROR GOTO 0
EXIT SUB

rstrt:
curByte = JPEGGetByte: curByte = JPEGGetByte: curByte = JPEGGetByte: curbits = 7
dcY = 0: dcCb = 0: dcCr = 0: mcu = 0
RETURN


ToRGB:
IF j2 <> lastj THEN
	cb128 = CbVector(I2, j2)
	cr128 = CrVector(I2, j2)
	r1 = 140& * cr128 \ 100
	g1 = (34 * cb128 + 71 * cr128) \ 100
	b1 = 177& * cb128 \ 100
	lastj = j2
END IF
r = y + r1
g = y - g1
b = y + b1
IF r > 255 THEN
	r = 255
ELSEIF r < 0 THEN
	r = 0
END IF
IF g > 255 THEN
	g = 255
ELSEIF g < 0 THEN
	g = 0
END IF
IF b > 255 THEN
	b = 255
ELSEIF b < 0 THEN
	b = 0
END IF
RETURN

END SUB

SUB JPEGViewParms
 SHARED f$
 CLS
 PRINT "Parameters of this JPEG File"
 PRINT
 PRINT "File Name            :  "; f$
 PRINT "File Size            : "; LOF(jfile); " bytes"
 PRINT "Comment              : "; imgcomment$
 PRINT "JFIF Version         : "; ASC(image.jfifmajor); "."; ASC(image.jfifMinor)
 PRINT "Rows X Cols          : "; image.rows; " x "; image.cols; " pixel"
 SELECT CASE ASC(image.densunits)
 CASE 0: unit$ = " ratio"
 CASE 1: unit$ = " dots/inch"
 CASE 2:  unit$ = " dots/cm"
 END SELECT
 PRINT "Density           X/Y: "; image.Xdens; "/"; image.ydens; unit$
 IF image.restart THEN
	PRINT "Restart each         : "; image.restart; " blocks"
 ELSE
	PRINT "No Restart marks in this file"
 END IF
 PRINT "Thumbnail w x h      : "; ASC(image.ThWidth); " x "; ASC(image.Theigth)
 
 IF image.numcomp = 3 THEN a$ = " Color Y + Cb + Cr" ELSE a$ = " Black & White"
 PRINT "Color components     : "; a$
 PRINT "Num of samples      Y: "; image.samplesy; : LOCATE , 50: PRINT "CbCr: "; image.samplescbcr
 PRINT
 PRINT "Quantization tables Y: "; image.qty + 1; : LOCATE , 50: PRINT "Cbcr: "; image.qtcbr - image.qty
 PRINT "Huffman tables DC   Y: "; image.HDCTY + 1; : LOCATE , 50: PRINT "CbCr: "; image.HDCTCBR - image.HDCTY
 PRINT "Huffman tables aC   Y: "; image.HaCTY + 1; : LOCATE , 50: PRINT "CbCr: "; image.HaCTCBR - image.HaCTY
 PRINT
 LOCATE 25, 1: PRINT "View It? [Y/N]...";
 SLEEP
END SUB

SUB SVGAGetData
REDIM modenums(70)
regs.AX = &H4F00
regs.ES = VARSEG(vesainfo)
regs.DI = VARPTR(vesainfo)
CALL INTERRUPTX(&H10, regs, regs)
IF regs.AX <> VESAOK THEN PRINT "SORRY...VESA CARD NOT DETECTED": END

'get mode numbers string
a$ = MKL$(vesainfo.VIDEOMODEPTR)
DEF SEG = CVI(RIGHT$(a$, 2))
ptr1 = CVI(LEFT$(a$, 2))
i = 0
DO UNTIL md& = 65535
	modenums(i) = md&
	i = i + 1
	temp = PEEK(ptr1)
	ptr1 = ptr1 + 1
	md& = PEEK(ptr1) * 256& + temp
	ptr1 = ptr1 + 1
LOOP
DEF SEG
vesainfo.modemax = i - 1

'get info about all modes
REDIM display(1 TO vesainfo.modemax) AS vesaModeinfoBlock
FOR i = 1 TO vesainfo.modemax
	regs.AX = &H4F01
	regs.cx = modenums(i)
	regs.ES = VARSEG(display(i))
	regs.DI = VARPTR(display(i))
	CALL INTERRUPTX(&H10, regs, regs)
	display(i).MODENUM = modenums(i)
NEXT
ERASE modenums

END SUB

SUB svgappgrey (x, y, lum) STATIC
IF y <> lasty THEN lasty = y: off1& = vesainfo.bytesrow * y
offset& = off1& + x
bank = offset& \ vesainfo.winsize
offset& = offset& MOD vesainfo.winsize
IF bank <> curbank THEN
  curbank = bank
  regs.AX = &H4F05
  regs.bx = 0
  regs.dx = curbank
  CALL INTERRUPTX(&H10, regs, regs)
END IF

DEF SEG = vesainfo.winseg
POKE offset&, lum
DEF SEG
END SUB

SUB SVGAPPixel (x, y, r, g, b) STATIC
'sets a pixel in SVGA screen
IF y <> lasty THEN lasty = y: off1& = vesainfo.bytesrow * y
offset& = off1& + x * vesainfo.bytespixel
bank = offset& \ vesainfo.winsize
offset& = offset& MOD vesainfo.winsize
IF bank <> curbank THEN
  SWAP curbank, bank
  GOSUB switchbank
END IF

SELECT CASE vesainfo.bpp
CASE 32:
	DEF SEG = vesainfo.winseg
	POKE offset& + 2, r
	POKE offset& + 1, g
	POKE offset&, b
	DEF SEG
CASE 16:
	temp& = (b \ 8) OR ((g * 8) AND &H7E0) OR (256& * r AND &HF800)
	b1 = VARPTR(temp&): a = PEEK(b1): a1 = PEEK(b1 + 1)
	DEF SEG = vesainfo.winseg: POKE offset&, a: POKE offset& + 1, a1: DEF SEG
CASE 24:
	'need to test for window boundary because 65536 (window size)is not divisible
	' by 3
	DEF SEG = vesainfo.winseg
	POKE offset&, b
	IF offset& = 65535 THEN curbank = curbank + 1: GOSUB switchbank: offset& = -1
	POKE offset& + 1, g
	IF offset& = 65534 THEN curbank = curbank + 1: GOSUB switchbank: offset& = -2
	POKE offset& + 2, r
	DEF SEG

CASE 8:
	tp1 = (r AND &HE0) OR ((g \ 8) AND &H1C) OR (b \ 64)
	DEF SEG = vesainfo.winseg: POKE offset&, tp1: DEF SEG
CASE 15:
	temp& = (b \ 8) OR ((g * 4) AND &H7E0) OR (128& * r AND &H7C00)
	b1 = VARPTR(temp&): a = PEEK(b1): a1 = PEEK(b1 + 1)
	DEF SEG = vesainfo.winseg: POKE offset&, a: POKE offset& + 1, a1: DEF SEG
END SELECT
EXIT SUB
switchbank:
  regs.AX = &H4F05
  regs.bx = 0
  regs.dx = curbank
  CALL INTERRUPTX(&H10, regs, regs)
RETURN

END SUB

SUB SVGAPrint (cad$, y, x, r, g, b)
'printing in SVGA
  x0 = x: grey = (r + g + b) \ 3
  FOR i = 1 TO LEN(cad$)  'for each char in string
	  a = ASC(MID$(cad$, i)) * 16 + of
	  x0 = x0 + 8
	  FOR j = 0 TO 15 'for each scan line in character map
		  DEF SEG = sg: b = PEEK(a + j): DEF SEG
		  IF b THEN
			  yj = y + j
			  FOR K = 0 TO 7 'for each bit  in scan line
				IF pwrsof2(K) AND b THEN
					IF vesainfo.bw = 1 THEN
						svgappgrey x0 - K, yj, grey
					ELSE
						SVGAPPixel x0 - K, yj, r, g, b
					END IF
				END IF
			  NEXT
		  END IF
	  NEXT
  NEXT
  
END SUB

FUNCTION SVGASelectMode%
SHARED f$, jfile
CLS
FOR i = 1 TO vesainfo.modemax: display(i).order = 0: NEXT
PRINT "The file "; jfile; " is "; image.cols; " X "; image.rows
PRINT
PRINT "Suitable SVGA VESA modes:"
j = 1
FOR i = 1 TO vesainfo.modemax
   IF display(i).Modeattributes AND 1 THEN
	SELECT CASE ASC(display(i).MemoryModel)
	CASE 4
		display(i).order = j
		PRINT USING "##.- MODE \ \H  #### x #### x ## "; j; HEX$(display(i).MODENUM); display(i).Xres; display(i).yres; ASC(display(i).bpp)
		j = j + 1
	CASE 6
		IF image.numcomp > 1 THEN   'not color modes for monochrome images
			display(i).order = j
			PRINT USING "##.- MODE \ \H  #### x #### x ## "; j; HEX$(display(i).MODENUM); display(i).Xres; display(i).yres; ASC(display(i).bpp)
			j = j + 1
		END IF

	END SELECT
   END IF
NEXT
j = j - 1
DO
INPUT "Select a mode"; K
LOOP UNTIL K > 0 AND K <= j
j = 0
DO
j = j + 1
LOOP UNTIL display(j).order = K
vesainfo.modeord = j
vesainfo.Xres = display(j).Xres
vesainfo.yres = display(j).yres
vesainfo.bytesrow = display(j).Bytesperscanline
vesainfo.bpp = ASC(display(j).bpp)
SELECT CASE vesainfo.bpp
CASE 8: temp = 1
CASE 15, 16: temp = 2
CASE 24: temp = 3
CASE 32: temp = 4

END SELECT
vesainfo.bytespixel = temp
vesainfo.winsize = 1024& * display(j).winsize
vesainfo.winseg = display(j).winAsegment
vesainfo.bw = 0


IF (ASC(display(j).bpp) = 8) AND (image.numcomp > 1) THEN
  INPUT "(B)lack & white /Approximative (C)olor: ", b$
  a = SVGASetMode(display(j).MODENUM)
   IF UCASE$(b$) = "B" THEN
	GOSUB setgreypal: vesainfo.bw = -1
   ELSE
	 GOSUB setaproxpal
   END IF
ELSEIF image.numcomp = 1 THEN
  a = SVGASetMode(display(j).MODENUM)
  GOSUB setgreypal: vesainfo.bw = -1

ELSE
	a = SVGASetMode(display(j).MODENUM)
END IF
EXIT FUNCTION

setgreypal:
OUT &H3C8, 0            'create the grayscale palette
FOR I1 = 0 TO 255: OUT &H3C9, I1 \ 4: OUT &H3C9, I1 \ 4: OUT &H3C9, I1 \ 4: NEXT
RETURN


setaproxpal:
'create approximative color palette
OUT &H3C8, 0
FOR I1 = 0 TO 7
	FOR J1 = 0 TO 7
		FOR K1 = 0 TO 4
			OUT &H3C9, I1 * 8
			OUT &H3C9, J1 * 8
			OUT &H3C9, K1 * 16
		NEXT
	NEXT
NEXT
RETURN

END FUNCTION

' Sets an SVGA mode.
FUNCTION SVGASetMode (MODE)

regs.AX = &H4F02  'Set the mode.
regs.bx = MODE
CALL INTERRUPTX(&H10, regs, regs)
IF regs.AX <> &H4F THEN SVGASetMode = 0: EXIT FUNCTION
regs.AX = &H4F07  'Set the top of the screen.
regs.bx = 0
regs.dx = 0
regs.cx = 0
CALL INTERRUPTX(&H10, regs, regs)



SVGASetMode = 1
END FUNCTION