QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-05 07:40:24 +00:00
Code Releases Wiki Activity
qb64/programs/samples/n54/big/jpegmake.bas

730 lines
16 KiB
QBasic
Raw Blame History

'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
View git blame Copy permalink