'JPEG Encoder v2 by Artelius 
'WARNING: OVERWRITES TEST.JPG
DECLARE FUNCTION Atan2! (X AS SINGLE, Y AS SINGLE)
DECLARE SUB PutChar (FileNo AS INTEGER, Char AS INTEGER)

DECLARE SUB JPEG.Precalc ()
DECLARE SUB JPEG.Begin (FileNo AS INTEGER, W AS INTEGER, H AS INTEGER, Sampling() AS INTEGER, State AS ANY, QT() AS INTEGER, Huff() AS INTEGER)
DECLARE SUB JPEG.Block.Output (B() AS INTEGER, State AS ANY, QT() AS INTEGER, Huff() AS INTEGER)
DECLARE SUB JPEG.StandardQT (quality AS SINGLE, QT() AS INTEGER)
DECLARE SUB JPEG.Finish (State AS ANY)
DECLARE FUNCTION JPEG.Category% (X AS INTEGER)
DECLARE FUNCTION JPEG.Cb% (R AS INTEGER, G AS INTEGER, B AS INTEGER)
DECLARE FUNCTION JPEG.Cr% (R AS INTEGER, G AS INTEGER, B AS INTEGER)
DECLARE FUNCTION JPEG.Y% (R AS INTEGER, G AS INTEGER, B AS INTEGER)

TYPE JPEGState
FileNo AS INTEGER
YCount AS INTEGER
CbCount AS INTEGER
CrCount AS INTEGER
YDC AS INTEGER
CbDC AS INTEGER
CrDC AS INTEGER
Position AS INTEGER
Leftover AS INTEGER
LeftoverBits AS INTEGER
END TYPE

'The following are internal to JPEG.
DECLARE SUB JPEG.ACHuff (RLE AS INTEGER, AC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS ANY)
DECLARE SUB JPEG.Block.Huffman (B() AS INTEGER, LastDC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS ANY)
DECLARE SUB JPEG.Block.Transform (B() AS INTEGER, O() AS INTEGER, QT() AS INTEGER, A AS INTEGER)
DECLARE SUB JPEG.DCHuff (DC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS ANY)
DECLARE SUB JPEG.GenerateHuffmanTable (Huff() AS INTEGER, A AS INTEGER, B AS INTEGER)
DECLARE SUB JPEG.PutBinString (BS AS INTEGER, Length AS INTEGER, State AS ANY)
DECLARE SUB JPEG.PutByte (FileNo AS INTEGER, Byte AS INTEGER)
DECLARE SUB JPEG.PutRightBinString (BS AS INTEGER, Length AS INTEGER, State AS ANY)
DECLARE SUB JPEG.PutWord (FileNo AS INTEGER, Word AS INTEGER)
DECLARE FUNCTION JPEG.Shift% (I AS INTEGER, N AS INTEGER)

DEFINT A-Z

DIM SHARED Pow2(0 TO 15) AS LONG
DIM SHARED Cosine(0 TO 7, 0 TO 7) AS SINGLE
DIM SHARED ZigZagX(0 TO 63) AS INTEGER, ZigZagY(0 TO 63) AS INTEGER
JPEG.Precalc

DIM Huff(0 TO 255, 0 TO 1, 0 TO 1, 0 TO 1) AS INTEGER
DIM QT(0 TO 7, 0 TO 7, 0 TO 1) AS INTEGER
DIM State AS JPEGState

DIM Sampling(0 TO 2, 0 TO 1) AS INTEGER
Sampling(0, 0) = 2 'Sampling factor (x then y) for luminance
Sampling(0, 1) = 2
Sampling(1, 0) = 1 'Sampling factor for "blue" chrominance
Sampling(1, 1) = 1
Sampling(2, 0) = 1 'Sampling factor for "red" chrominance
Sampling(2, 1) = 1


'Delete file then open for binary
OPEN "test.jpg" FOR OUTPUT AS #1
CLOSE
OPEN "test.jpg" FOR BINARY AS #1

'Set quality tables
'The smaller the paramter, the higher the quality
'0.01 is 100% quality
JPEG.StandardQT .5, QT()

'Start image (64x64)
JPEG.Begin 1, 128, 128, Sampling(), State, QT(), Huff()


DIM B(0 TO 7, 0 TO 7) AS INTEGER

FOR SuperY = 0 TO 127 STEP 16
FOR SuperX = 0 TO 127 STEP 16

'Output the luminance blocks

FOR BlockY = 0 TO 15 STEP 8
FOR BlockX = 0 TO 15 STEP 8
FOR OffY = 0 TO 7: FOR OffX = 0 TO 7
X! = OffX + BlockX + SuperX - 63.5
Y! = OffY + BlockY + SuperY - 63.5
D! = SQR(X! * X! + Y! * Y!) / 6 + Atan2(X!, Y!)
R = 255
G = 255 - (COS(D!) + 1) * 127.5
B = 255 - (COS(D!) + 1) * 127.5
B(OffX, OffY) = JPEG.Y(R, G, B)
NEXT OffX, OffY
JPEG.Block.Output B(), State, QT(), Huff()
NEXT BlockX, BlockY

'Output the blue chrominance block

FOR OffY = 0 TO 7: FOR OffX = 0 TO 7
X! = OffX * 2 + SuperX - 63
Y! = OffY * 2 + SuperY - 63
D! = SQR(X! * X! + Y! * Y!) / 6 + Atan2(X!, Y!)
R = 255
G = 255 - (COS(D!) + 1) * 127.5
B = 255 - (COS(D!) + 1) * 127.5
B(OffX, OffY) = JPEG.Cb(R, G, B)
NEXT OffX, OffY
JPEG.Block.Output B(), State, QT(), Huff()

'Output the red chrominance block

FOR OffY = 0 TO 7: FOR OffX = 0 TO 7
X! = OffX * 2 + SuperX - 63
Y! = OffY * 2 + SuperY - 63
D! = SQR(X! * X! + Y! * Y!) / 6 + Atan2(X!, Y!)
R = 255
G = 255 - (COS(D!) + 1) * 127.5
B = 255 - (COS(D!) + 1) * 127.5
B(OffX, OffY) = JPEG.Cr(R, G, B)
NEXT OffX, OffY
JPEG.Block.Output B(), State, QT(), Huff()

NEXT SuperX, SuperY


JPEG.Finish State

CLOSE

END

Huff0:
DATA 0
DATA 1, 0
DATA 5, 1, 2, 3, 4, 5
DATA 1, 6
DATA 1, 7
DATA 1, 8
DATA 1, 9
DATA 1, 10
DATA 1, 11
DATA 0, 0, 0, 0, 0, 0, 0

Huff1:
DATA 0
DATA 3, 0, 1, 2
DATA 1, 3
DATA 1, 4
DATA 1, 5
DATA 1, 6
DATA 1, 7
DATA 1, 8
DATA 1, 9
DATA 1, 10
DATA 1, 11
DATA 0, 0, 0, 0, 0

Huff2:
DATA 0
DATA 2, 1, 2
DATA 1, 3
DATA 3, 0, 4, &H11
DATA 3, 5, &H12, &H21
DATA 2, &H31, &H41
DATA 4, 6, &H13, &H51, &H61
DATA 3, 7, &H22, &H71
DATA 5, &H14, &H32, &H81, &H91, &HA1
DATA 5, &H08, &H23, &H42, &HB1, &HC1
DATA 4, &H15, &H52, &HD1, &HF0
DATA 4, &H24, &H33, &H62, &H72
DATA 0
DATA 0
DATA 1, &H82
DATA 125, &H09, &H0A, &H16, &H17, &H18, &H19, &H1A, &H25, &H26, &H27, &H28, &H29, &H2A, &H34, &H35, &H36
DATA &H37, &H38, &H39, &H3A, &H43, &H44, &H45, &H46, &H47, &H48, &H49, &H4A, &H53, &H54, &H55, &H56
DATA &H57, &H58, &H59, &H5A, &H63, &H64, &H65, &H66, &H67, &H68, &H69, &H6A, &H73, &H74, &H75, &H76
DATA &H77, &H78, &H79, &H7A, &H83, &H84, &H85, &H86, &H87, &H88, &H89, &H8A, &H92, &H93, &H94, &H95
DATA &H96, &H97, &H98, &H99, &H9A, &HA2, &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, &HA9, &HAA, &HB2, &HB3
DATA &HB4, &HB5, &HB6, &HB7, &HB8, &HB9, &HBA, &HC2, &HC3, &HC4, &HC5, &HC6, &HC7, &HC8, &HC9, &HCA
DATA &HD2, &HD3, &HD4, &HD5, &HD6, &HD7, &HD8, &HD9, &HDA, &HE1, &HE2, &HE3, &HE4, &HE5, &HE6, &HE7
DATA &HE8, &HE9, &HEA, &HF1, &HF2, &HF3, &HF4, &HF5, &HF6, &HF7, &HF8, &HF9, &HFA

Huff3:
DATA 0
DATA 2, 0, 1
DATA 1, 2
DATA 2, 3, &H11
DATA 4, 4, 5, &H21, &H31
DATA 4, 6, &H12, &H41, &H51
DATA 3, 7, &H61, &H71
DATA 4, &H13, &H22, &H32, &H81
DATA 7, 8, &H14, &H42, &H91, &HA1, &HB1, &HC1
DATA 5, 9, &H23, &H33, &H52, &HF0
DATA 4, &H15, &H62, &H72, &HD1
DATA 4, &HA, &H16, &H24, &H34
DATA 0
DATA 1, &HE1
DATA 2, &H25, &HF1
DATA 119, &H17, &H18, &H19, &H1A, &H26, &H27, &H28, &H29, &H2A, &H35, &H36, &H37, &H38, &H39, &H3A, &H43
DATA &H44, &H45, &H46, &H47, &H48, &H49, &H4A, &H53, &H54, &H55, &H56, &H57, &H58, &H59, &H5A, &H63
DATA &H64, &H65, &H66, &H67, &H68, &H69, &H6A, &H73, &H74, &H75, &H76, &H77, &H78, &H79, &H7A, &H82
DATA &H83, &H84, &H85, &H86, &H87, &H88, &H89, &H8A, &H92, &H93, &H94, &H95, &H96, &H97, &H98, &H99
DATA &H9A, &HA2, &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, &HA9, &HAA, &HB2, &HB3, &HB4, &HB5, &HB6, &HB7
DATA &HB8, &HB9, &HBA, &HC2, &HC3, &HC4, &HC5, &HC6, &HC7, &HC8, &HC9, &HCA, &HD2, &HD3, &HD4, &HD5
DATA &HD6, &HD7, &HD8, &HD9, &HDA, &HE2, &HE3, &HE4, &HE5, &HE6, &HE7, &HE8, &HE9, &HEA, &HF2, &HF3
DATA &HF4, &HF5, &HF6, &HF7, &HF8, &HF9, &HFA

StandardQT:
DATA 16, 11, 10, 16, 24, 40, 51, 61
DATA 12, 12, 14, 19, 26, 58, 60, 55
DATA 14, 13, 16, 24, 40, 57, 69, 56
DATA 14, 17, 22, 29, 51, 87, 80, 62
DATA 18, 22, 37, 56, 68, 109, 103, 77
DATA 24, 35, 55, 64, 81, 104, 113, 92
DATA 49, 64, 78, 87, 103, 121, 120, 101
DATA 72, 92, 95, 98, 112, 100, 103, 99

DATA 17, 18, 24, 47, 99, 99, 99, 99
DATA 18, 24, 26, 66, 99, 99, 99, 99
DATA 24, 26, 56, 99, 99, 99, 99, 99
DATA 47, 66, 99, 99, 99, 99, 99, 99
DATA 99, 99, 99, 99, 99, 99, 99, 99
DATA 99, 99, 99, 99, 99, 99, 99, 99
DATA 99, 99, 99, 99, 99, 99, 99, 99
DATA 99, 99, 99, 99, 99, 99, 99, 99

DEFSNG A-Z
FUNCTION Atan2! (X AS SINGLE, Y AS SINGLE)

'Code borrowed from London
Atan2 = ATN(Y / X) - ATN(1) * 4 * (X < 0 - 2 * (X < 0 AND Y < 0))

END FUNCTION

SUB JPEG.ACHuff (RLE AS INTEGER, AC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS JPEGState)
DIM C AS INTEGER, X AS INTEGER
C = JPEG.Category(AC)
X = RLE * 16 + C
JPEG.PutBinString Huff(X, 1, A, 0), Huff(X, 1, A, 1), State
JPEG.PutRightBinString AC + (AC < 0), C, State
END SUB

SUB JPEG.Begin (FileNo AS INTEGER, W AS INTEGER, H AS INTEGER, Sampling() AS INTEGER, State AS JPEGState, QT() AS INTEGER, Huff() AS INTEGER)

DIM I AS INTEGER, J AS INTEGER, X AS INTEGER, Y AS INTEGER, T AS INTEGER

State.FileNo = FileNo

RESTORE Huff0
JPEG.GenerateHuffmanTable Huff(), 0, 0
JPEG.GenerateHuffmanTable Huff(), 0, 1
JPEG.GenerateHuffmanTable Huff(), 1, 0
JPEG.GenerateHuffmanTable Huff(), 1, 1


State.YCount = Sampling(0, 0) * Sampling(0, 1)
State.CbCount = Sampling(1, 0) * Sampling(1, 1)
State.CrCount = Sampling(2, 0) * Sampling(2, 1)
State.YDC = 0
State.CbDC = 0
State.CrDC = 0

State.Position = 0

State.Leftover = 0
State.LeftoverBits = 0


'SOI
PutChar FileNo, 255
PutChar FileNo, 216
'APP0
PutChar FileNo, 255
PutChar FileNo, 224
JPEG.PutWord FileNo, 16
S$ = "JFIF" + CHR$(0): PUT FileNo, , S$
PutChar FileNo, 1
PutChar FileNo, 2
PutChar FileNo, 0
PutChar FileNo, 0
PutChar FileNo, 1
PutChar FileNo, 0
PutChar FileNo, 1
PutChar FileNo, 0
PutChar FileNo, 0

'DQT
PutChar FileNo, 255
PutChar FileNo, 219
JPEG.PutWord FileNo, 132

PutChar FileNo, 0
FOR I = 0 TO 63
PutChar FileNo, QT(ZigZagX(I), ZigZagY(I), 0)
NEXT



PutChar FileNo, 1
FOR I = 0 TO 63
PutChar FileNo, QT(ZigZagX(I), ZigZagY(I), 1)
NEXT



'DHT
PutChar FileNo, 255
PutChar FileNo, 196
T = 2 + 4 * (16 + 1)
RESTORE Huff0
FOR I = 1 TO 16 * 4
READ X
FOR J = 1 TO X
READ Y
T = T + 1
NEXT
NEXT

JPEG.PutWord FileNo, T

PutChar FileNo, 0
RESTORE Huff0
FOR I = 1 TO 16
READ X
PutChar FileNo, X
FOR J = 1 TO X
READ Y
NEXT
NEXT
RESTORE Huff0
FOR I = 1 TO 16
READ X
FOR J = 1 TO X
READ Y
PutChar FileNo, Y
NEXT
NEXT

PutChar FileNo, 1
RESTORE Huff1
FOR I = 1 TO 16
READ X
PutChar FileNo, X
FOR J = 1 TO X
READ Y
NEXT
NEXT
RESTORE Huff1
FOR I = 1 TO 16
READ X
FOR J = 1 TO X
READ Y
PutChar FileNo, Y
NEXT
NEXT

PutChar FileNo, 16
RESTORE Huff2
FOR I = 1 TO 16
READ X
PutChar FileNo, X
FOR J = 1 TO X
READ Y
NEXT
NEXT
RESTORE Huff2
FOR I = 1 TO 16
READ X
FOR J = 1 TO X
READ Y
PutChar FileNo, Y
NEXT
NEXT

PutChar FileNo, 17
RESTORE Huff3
FOR I = 1 TO 16
READ X
PutChar FileNo, X
FOR J = 1 TO X
READ Y
NEXT
NEXT
RESTORE Huff3
FOR I = 1 TO 16
READ X
FOR J = 1 TO X
READ Y
PutChar FileNo, Y
NEXT
NEXT

'SOF0
PutChar FileNo, 255
PutChar FileNo, 192
JPEG.PutWord FileNo, 8 + 9
PutChar FileNo, 8
JPEG.PutWord FileNo, H
JPEG.PutWord FileNo, W

PutChar FileNo, 3

PutChar FileNo, 1
PutChar FileNo, Sampling(0, 0) * 16 + Sampling(0, 1)
PutChar FileNo, 0
PutChar FileNo, 2
PutChar FileNo, Sampling(1, 0) * 16 + Sampling(1, 1)
PutChar FileNo, 1
PutChar FileNo, 3
PutChar FileNo, Sampling(2, 0) * 16 + Sampling(2, 1)
PutChar FileNo, 1

'SOS

PutChar FileNo, 255
PutChar FileNo, 218
JPEG.PutWord FileNo, 12

PutChar FileNo, 3

PutChar FileNo, 1
PutChar FileNo, &H0
PutChar FileNo, 2
PutChar FileNo, &H11
PutChar FileNo, 3
PutChar FileNo, &H11

PutChar FileNo, 0
PutChar FileNo, 63
PutChar FileNo, 0

END SUB

SUB JPEG.Block.Huffman (B() AS INTEGER, LastDC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS JPEGState)
DIM DC AS INTEGER, I AS INTEGER
DIM C AS INTEGER
DC = B(0) - LastDC
JPEG.DCHuff DC, Huff(), A, State
B(64) = -1

I = 1
DO
C = 0
IF B(I) = 0 THEN

DO
I = I + 1
C = C + 1
LOOP WHILE B(I) = 0
IF I = 64 THEN

JPEG.PutBinString Huff(0, 1, A, 0), Huff(0, 1, A, 1), State
EXIT DO
END IF
WHILE C >= 16

JPEG.PutBinString Huff(&HF0, 1, A, 0), Huff(&HF0, 1, A, 1), State
C = C - 16
WEND

END IF


JPEG.ACHuff C, B(I), Huff(), A, State
I = I + 1
LOOP WHILE I < 64
END SUB

SUB JPEG.Block.Output (B() AS INTEGER, State AS JPEGState, QT() AS INTEGER, Huff() AS INTEGER)

DIM O(0 TO 64) AS INTEGER
State.Position = State.Position + 1
IF State.Position > State.YCount + State.CbCount + State.CrCount THEN State.Position = 1
IF State.Position <= State.YCount THEN
JPEG.Block.Transform B(), O(), QT(), 0
JPEG.Block.Huffman O(), State.YDC, Huff(), 0, State
State.YDC = O(0)
ELSE
JPEG.Block.Transform B(), O(), QT(), 1
IF State.Position <= State.YCount + State.CbCount THEN
JPEG.Block.Huffman O(), State.CbDC, Huff(), 1, State
State.CbDC = O(0)
ELSE
JPEG.Block.Huffman O(), State.CrDC, Huff(), 1, State
State.CrDC = O(0)
END IF
END IF

END SUB

SUB JPEG.Block.Transform (B() AS INTEGER, O() AS INTEGER, QT() AS INTEGER, A AS INTEGER)
DIM U AS INTEGER, V AS INTEGER, X AS INTEGER, Y AS INTEGER
DIM B2(0 TO 7, 0 TO 7) AS SINGLE
DIM T AS SINGLE

FOR V = 0 TO 7: FOR U = 0 TO 7
T = 0
FOR X = 0 TO 7
T = T + B(X, V) * Cosine(X, U)
NEXT X
B2(U, V) = T
NEXT U, V

FOR U = 0 TO 7: FOR V = 0 TO 7
T = 0
FOR Y = 0 TO 7
T = T + B2(U, Y) * Cosine(Y, V)
NEXT Y
T = T / 4
IF U = 0 THEN T = T / SQR(2)
IF V = 0 THEN T = T / SQR(2)
B(U, V) = CINT(T / QT(U, V, A))
NEXT V, U

FOR U = 0 TO 63
O(U) = B(ZigZagX(U), ZigZagY(U))
NEXT

END SUB

FUNCTION JPEG.Category% (X AS INTEGER)
DIM T AS INTEGER, I AS INTEGER
T = ABS(X)
WHILE T
T = T \ 2
I = I + 1
WEND
JPEG.Category = I
END FUNCTION

FUNCTION JPEG.Cb% (R AS INTEGER, G AS INTEGER, B AS INTEGER)

JPEG.Cb = -.1687 * R - .3313 * G + .5 * B

END FUNCTION

FUNCTION JPEG.Cr% (R AS INTEGER, G AS INTEGER, B AS INTEGER)

JPEG.Cr = .5 * R - .4187 * G - .0813 * B

END FUNCTION

SUB JPEG.DCHuff (DC AS INTEGER, Huff() AS INTEGER, A AS INTEGER, State AS JPEGState)
DIM C AS INTEGER
C = JPEG.Category(DC)
JPEG.PutBinString Huff(C, 0, A, 0), Huff(C, 0, A, 1), State
JPEG.PutRightBinString DC + (DC < 0), C, State
END SUB

SUB JPEG.Finish (State AS JPEGState)

DEF SEG = VARSEG(State.Leftover)
IF State.LeftoverBits > 8 THEN
JPEG.PutByte State.FileNo, PEEK(VARPTR(State.Leftover) + 1)
POKE VARPTR(State.Leftover) + 1, State.Leftover AND 255
State.LeftoverBits = State.LeftoverBits - 8
END IF

IF State.LeftoverBits THEN
JPEG.PutByte State.FileNo, PEEK(VARPTR(State.Leftover) + 1) OR (Pow2(8 - State.LeftoverBits) - 1)
END IF
DEF SEG

'EOF marker
PutChar State.FileNo, 255
PutChar State.FileNo, 217

END SUB

SUB JPEG.GenerateHuffmanTable (Huff() AS INTEGER, A AS INTEGER, B AS INTEGER)
DIM S AS LONG, I AS INTEGER, J AS INTEGER, T AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
S = -1

FOR I = 1 TO 16
READ X
FOR J = 1 TO X

IF S = -1 THEN
S = 0
ELSE
S = S + Pow2(T)
END IF


READ Y
IF S AND 32768 THEN Huff(Y, A, B, 0) = CINT(S AND 32767&) OR -32768 ELSE Huff(Y, A, B, 0) = S
Huff(Y, A, B, 1) = I
T = 16 - I

NEXT
NEXT
END SUB

SUB JPEG.Precalc
DIM X AS INTEGER, Y AS INTEGER, T AS INTEGER, Dir AS INTEGER, L AS LONG

L = 1
FOR X = 0 TO 15
Pow2(X) = L
L = L + L
NEXT
FOR Y = 0 TO 7
FOR X = 0 TO 7
Cosine(X, Y) = COS((2 * X + 1) * Y * .1963495)
NEXT X, Y

X = 0: Y = 0
T = 0
Dir = 0
DO
ZigZagX(T) = X
ZigZagY(T) = Y
T = T + 1
IF T = 64 THEN EXIT DO
IF Dir THEN
IF Y = 7 THEN
X = X + 1
Dir = 0
ELSEIF X = 0 THEN
Y = Y + 1
Dir = 0
ELSE
X = X - 1
Y = Y + 1
END IF

ELSE
IF Y = 0 THEN
X = X + 1
Dir = 1
ELSEIF X = 7 THEN
Y = Y + 1
Dir = 1
ELSE
X = X + 1
Y = Y - 1
END IF
END IF
LOOP



END SUB

SUB JPEG.PutBinString (BS AS INTEGER, Length AS INTEGER, State AS JPEGState)
DIM Temp AS INTEGER

Temp = BS
State.Leftover = State.Leftover OR JPEG.Shift(Temp, State.LeftoverBits)
State.LeftoverBits = State.LeftoverBits + Length
IF State.LeftoverBits >= 16 THEN
DEF SEG = VARSEG(State.Leftover)
JPEG.PutByte State.FileNo, PEEK(VARPTR(State.Leftover) + 1)
DEF SEG
JPEG.PutByte State.FileNo, State.Leftover AND 255
State.LeftoverBits = State.LeftoverBits - 16
State.Leftover = Temp
END IF

END SUB

SUB JPEG.PutByte (FileNo AS INTEGER, Byte AS INTEGER)
DIM C AS STRING * 1
C = CHR$(Byte)
PUT FileNo, , C
IF Byte = 255 THEN C = CHR$(0): PUT FileNo, , C
END SUB

SUB JPEG.PutRightBinString (BS AS INTEGER, Length AS INTEGER, State AS JPEGState)

DIM Temp AS LONG
IF Length THEN
Temp = (CLNG(BS) AND Pow2(Length) - 1) * Pow2(16 - Length)
IF Temp AND 32768 THEN Temp = Temp OR -65536
JPEG.PutBinString CINT(Temp), Length, State
END IF

END SUB

SUB JPEG.PutWord (FileNo AS INTEGER, Word AS INTEGER)
DIM C AS STRING * 1
C = CHR$(Word \ 256)
PUT FileNo, , C
C = CHR$(Word AND 255)
PUT FileNo, , C
END SUB

FUNCTION JPEG.Shift% (I AS INTEGER, N AS INTEGER)
DIM T AS LONG

IF N = 0 THEN
JPEG.Shift = I
I = 0
EXIT FUNCTION
END IF
T = CLNG(I) AND 65535

JPEG.Shift = T \ Pow2(N)

T = (T AND (Pow2(N) - 1)) * Pow2((16 - N) AND 15)
IF T AND 32768 THEN I = CINT(T AND 32767&) OR -32768 ELSE I = CINT(T)
END FUNCTION

SUB JPEG.StandardQT (quality AS SINGLE, QT() AS INTEGER)

DIM I AS INTEGER, X AS INTEGER, Y AS INTEGER, T AS INTEGER
RESTORE StandardQT

FOR I = 0 TO 1: FOR Y = 0 TO 7: FOR X = 0 TO 7
READ T

QT(X, Y, I) = T * quality

IF QT(X, Y, I) = 0 THEN QT(X, Y, I) = 1
NEXT X, Y, I

END SUB

FUNCTION JPEG.Y% (R AS INTEGER, G AS INTEGER, B AS INTEGER)

JPEG.Y = .299 * R + .587 * G + .114 * B - 128

END FUNCTION

SUB PutChar (FileNo AS INTEGER, Char AS INTEGER)
DIM C AS STRING * 1
C = CHR$(Char)
PUT FileNo, , C
END SUB