initial upload

This commit is contained in:
Charles Mangin 2021-06-12 00:21:56 -04:00 committed by GitHub
parent 8a0d293e51
commit b04b161ee6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 748 additions and 0 deletions

730
QR.6502 Normal file
View File

@ -0,0 +1,730 @@
DSK QRCODE
**************************************************
* To Do:
* Switch from alphanumeric to byte mode, based
* on message length, or content
*
**************************************************
* Variables
**************************************************
LOBYTE EQU $00
HIBYTE EQU $01
BITCOUNTER EQU $02
BYTECOUNTER EQU $03
MESSAGELENGTH EQU $04
ROW EQU $05
COLUMN EQU $06
TEMP EQU $07
MODE EQU $08
MESSAGE EQU $200 ; string input from basic program
STORAGE EQU $3000 ; PUT THE WORKING BYTES HERE
MPINTS EQU $3100 ; QR MESSAGE BYTES
MPEXP EQU $3180
SCRATCH EQU $3200
XORRESULT EQU $3280
**************************************************
* Apple Standard Memory Locations
**************************************************
CLRLORES EQU $F832
LORES EQU $C050
TXTSET EQU $C051
MIXCLR EQU $C052
MIXSET EQU $C053
TXTPAGE1 EQU $C054
TXTPAGE2 EQU $C055
KEY EQU $C000
C80STOREOF EQU $C000
C80STOREON EQU $C001
STROBE EQU $C010
SPEAKER EQU $C030
VBL EQU $C02E
RDVBLBAR EQU $C019 ;not VBL (VBL signal low
WAIT EQU $FCA8
RAMWRTAUX EQU $C005
RAMWRTMAIN EQU $C004
SETAN3 EQU $C05E ;Set annunciator-3 output to 0
SET80VID EQU $C00D ;enable 80-column display mode (WR-only)
CLR80VID EQU $C00C
HOME EQU $FC58 ; clear the text screen
CH EQU $24 ; cursor Horiz
CV EQU $25 ; cursor Vert
VTAB EQU $FC22 ; Sets the cursor vertical position (from CV)
COUT EQU $FDED ; Calls the output routine whose address is stored in CSW,
; normally COUTI
STROUT EQU $DB3A ;Y=String ptr high, A=String ptr low
ALTTEXT EQU $C055
ALTTEXTOFF EQU $C054
RDPAGE2 EQU $C01C ; high bit set if on page2
ROMINIT EQU $FB2F
ROMSETKBD EQU $FE89
ROMSETVID EQU $FE93
**************************************************
* Let's get this party started
**************************************************
ORG $2000 ; PROGRAM DATA STARTS AT $2000
JSR ROMINIT ; GR/HGR off, Text page 1
LDA #$00
STA LORES ; low res graphics mode
STA MIXCLR
JSR CLEARSCREEN ; BLANK SCREEN
**************************************************
* TO DO: Analyze message bytes. Max length of 78 characters
* for byte mode, 114 for alphanumeric mode.
* If >78 then check for non-alphanumeric characters.
**************************************************
; LDA #$40 ; MODE BYTE - #$20 FOR ALPHANUMERIC, #$40 FOR BYTE
; STA MODE
LDA MODE
CMP #$40
BEQ BYTEMODE
LDY #$FF
CONVERT44 ; FOR EACH CHARACTER OF THE MESSAGE, CONVERT TO ALPHANUMERIC 0-44
INY
LDX MESSAGE,Y
BEQ CONVERT11
LDA ALPHANUM,X
STA MESSAGE,Y
JMP CONVERT44
* break message into character pairs
* convert character pairs into numbers
CONVERT11 STY MESSAGELENGTH
LDY #$00
GETMESSAGE LDA MESSAGE,Y ; 0
STA $FC
JSR MULT45 ; RESULT IN FE,FD
CLC
INY ; 1
LDA MESSAGE,Y
ADC $FD
STA $FD
BCC STOREPAIR
INC $FE ; RESULT IN FE,FD
STOREPAIR DEY ; 0
LDA $FE
STA STORAGE,Y ; HI BYTE
INY ; 1
LDA $FD
STA STORAGE,Y ; LO BYTE
INY ; 2
CPY MESSAGELENGTH
BEQ BUILDQR
BCS BUILDQR
JMP GETMESSAGE
**************************************************
* Byte mode = ROR each byte in message 4x, append to mode/length bits.
**************************************************
BYTEMODE LDY #$00
FINDLENGTH LDX MESSAGE,Y
BEQ FOUNDLENGTH
INY
JMP FINDLENGTH
FOUNDLENGTH STY MESSAGELENGTH
LDX MESSAGELENGTH
DEX
LDA MESSAGE,X ; LAST BYTE OF MESSAGE
AND #$0F ; LO 4 BITS
CLC
ROL
ROL
ROL
ROL
INX
STA STORAGE,X ; 4 BITS AT END OF CONVERTED MESSAGE
COPYMSG LDX #$0 ; COPY THE MESSAGE TO STORAGE
COPYBYTE LDA MESSAGE,X
STA STORAGE,X
INX
CPX MESSAGELENGTH
BNE COPYBYTE
LDY #$04
RORMSG LDX #$0
CLC
PHP
RORBYTE PLP
ROR STORAGE,X
INX
PHP ; PRESERVES CARRY
CPX MESSAGELENGTH ; BECAUSE CPX CLOBBERS IT
BNE RORBYTE
DEY
BNE RORMSG
BUILDQR
**************************************************
* pad with mode/char count
* alphanumeric mode = 0010
* 0 0010 0000 9 bits character count (EG #$20)
* 0010 0001 0000 0
* Byte mode = 0100 & 8 bits CHARACTER COUNT
**************************************************
LDA MESSAGELENGTH ; NNNNXXXX
CLC
LDX MODE
CPX #$40
BEQ LSR4X
LSR5X LSR ; 5X FOR ALPHANUM MODE, 4X FOR BYTE MODE
LSR4X LSR
LSR
LSR ; -> 5X
LSR ; 0 0000 NNN
ORA MODE ; 0010 0NNN OR 0100 NNNN
LDY #$0
STA MPINTS,Y ; FIRST MESSAGE BYTE = 4 BITS MODE, PLUS 4 BITS LENGTH
LDA MESSAGELENGTH ; NNNNXXXX
CPX #$40
BNE DOALPHAMODE
JMP DOBYTEMODE
DOALPHAMODE AND #$1F ; 000NXXXX
CLC
ROL ; <- 3X
ROL
ROL ; NXXXX 000
LDX #$0
ORA STORAGE,X ; 3 BITS OF FIRST HI BYTE
INY
STA MPINTS,Y
INX
INY
LDA STORAGE,X ; FIRST LO BYTE
STA MPINTS,Y ; HOW CONVENIENT. FIRST PAIR OF BYTES ENDS ON AN 8X BOUNDARY.
INY ; SET UP NEXT BYTE OF QR
* FOR EACH REMAINING PAIR OF BYTES, GET 3 BITS FROM HI, 8 BITS FROM LO
LDA #$08
STA BITCOUNTER ; CURRENT BIT OF QR ENCODING CYCLE
LDA MPINTS,Y ; CURRENT BYTE OF QR DATA
LDX #$02 ; WHICH BYTE OF MESSAGE
NEXTMBYTE ROL STORAGE,X ; HI BYTE - ROL 5X
ROL STORAGE,X
ROL STORAGE,X
ROL STORAGE,X
ROL STORAGE,X ; BIT 5 -> BIT 0
BIT0 ROL STORAGE,X ; BIT 0 INTO CARRY
ROL ; CARRY INTO NEXT BIT OF QR
DEC BITCOUNTER ; DONE WITH A FULL BYTE OF QR? 7
BNE BIT1
JSR NEXTQRBYTE
BIT1 ROL STORAGE,X ; BIT 1 INTO CARRY
ROL
DEC BITCOUNTER ; 6
BNE BIT2
JSR NEXTQRBYTE
BIT2 ROL STORAGE,X ; BIT 2 INTO CARRY
ROL
DEC BITCOUNTER ; 5
BNE BIT3
JSR NEXTQRBYTE
BIT3 INX ; FINISHED WITH HI BYTE
ROL STORAGE,X ; BIT 0 OF LO BYTE INTO CARRY
ROL
DEC BITCOUNTER ; 4
BNE BIT4
JSR NEXTQRBYTE
BIT4 ROL STORAGE,X ; AND SO ON...
ROL
DEC BITCOUNTER ; 3
BNE BIT5
JSR NEXTQRBYTE
BIT5 ROL STORAGE,X
ROL
DEC BITCOUNTER ; 2
BNE BIT6
JSR NEXTQRBYTE
BIT6 ROL STORAGE,X
ROL
DEC BITCOUNTER ; 1
BNE BIT7
JSR NEXTQRBYTE
BIT7 ROL STORAGE,X
ROL
DEC BITCOUNTER ; 0
BNE BIT8
JSR NEXTQRBYTE
BIT8 ROL STORAGE,X
ROL
DEC BITCOUNTER
BNE BIT9
JSR NEXTQRBYTE
BIT9 ROL STORAGE,X
ROL
DEC BITCOUNTER
BNE BIT10
JSR NEXTQRBYTE
BIT10 ROL STORAGE,X
ROL
DEC BITCOUNTER
BNE NEXTHIBYTE
JSR NEXTQRBYTE
NEXTHIBYTE INX
CPX MESSAGELENGTH ; up to 114 BYTES OF MESSAGE
BEQ PADBYTES
BCS PADBYTES
JMP NEXTMBYTE ; 3 BITS OF HI BYTE AND 8 OF LO BYTE ROTATED INTO QR BYTESTREAM
DOBYTEMODE AND #$0F ; A=MESSAGELENGTH. 0000XXXX
CLC
ROL
ROL
ROL
ROL ; XXXX____
ORA STORAGE,Y
INY
BYTEMODELOOP STA MPINTS,Y
CPY MESSAGELENGTH
BEQ LASTBYTE
LDA STORAGE,Y
INY
JMP BYTEMODELOOP
LASTBYTE LDA STORAGE,Y
INY
STA MPINTS,Y
JMP PADLOOP
* pad to 80 bytes with 0s and 11101100 00010001 (#$EC #$11)
PADBYTES LDX BITCOUNTER ; ALWAYS TERMINATE WITH 4 ZEROES
PADBYTES2 CLC
DEC BITCOUNTER
BMI PADBITS
ROL
JMP PADBYTES2
PADBITS STA MPINTS,Y ; STORE INCOMPLETE BYTE WITH TRAILING ZEROS
CPX #$04 ; NEEDS TO BE AT LEAST 4 FOR TERMINATOR
BCS PADLOOP
INY
PADLOOP INY ; NEXT QR BYTE
CPY #$50
BEQ DOECCBYTES ; ARE WE DONE HERE?
LDA #$EC
STA MPINTS,Y
INY ; NEXT QR BYTE
CPY #$50
BEQ DOECCBYTES ; ARE WE DONE HERE?
LDA #$11
STA MPINTS,Y
JMP PADLOOP
DOECCBYTES LDX #$0 ; OH, THIS GON' BE FUN.
LDA #$50
STA BYTECOUNTER ; HOW MANY TIMES HAVE WE BEEN HERE BEFORE?
COPYBYTES LDA MPINTS,X ; COPY COMPLETE MESSAGE BYTES TO STORAGE SPACE AT $8000
STA STORAGE,X
INX
CPX #$51 ; DONE ALL 80 BYTES
BNE COPYBYTES
ECCSTEP1 LDX #$0 ; convert integers in message to exponents
MSGTOEXP LDY MPINTS,X ; convert integers in message to exponents
LDA INTTOEXP,Y
STA MPEXP,X
INX
CPX #$51
BNE MSGTOEXP ; MSG EXPONENTS IN MPEXP
ECCSTEP2 LDX #$0 ; Multiply the Generator Polynomial by the Lead EXPONENT of the Message Polynomial
STEP2LOOP LDA MPEXP ; mp first exponent
CLC
ADC GENERATOR,X ; ADDED TO each gp exponent
TAY
BCC SCRATCHINT ; MOD 255 ON ROLLOVER > FF ADDS CARRY
INY
SCRATCHINT LDA EXPTOINT,Y ; convert EXPONENTS in RESULT to INTEGERS
STA SCRATCH,X ; STORE IN WORK AREA 2
INX
CPX #$15
BNE STEP2LOOP ; INTEGER RESULTS IN SCRATCH
ECCSTEP3 LDX #$0 ; XOR the result with the message polynomial (INTEGERS)
XORBYTE LDA SCRATCH,X ; INTEGER RESULT OF MULTIPLICATION
EOR MPINTS,X ; INTEGER TERMS OF MESSAGE
STOREXOR STA XORRESULT,X ; RESULT FEEDS INTO STEP 1
INX
CPX #$51
BNE XORBYTE
; XORRESULT CONTAINS INTEGER RESULT
******
* if the lead term of the xor result is also 0, you should discard it as well
*****
SKIPZERO LDX XORLO ; FIRST RESULT IS ALWAYS ZERO.
INX ; SO SKIP IT
STX LOBYTE
LDA XORHI
STA HIBYTE
LDY #$0 ; convert integers in RESULT to exponents
FINDZERO LDA (LOBYTE),Y ; FIND LEADING ZERO TERM(s)
BNE XORTOEXP
INC LOBYTE
DEC BYTECOUNTER
JMP FINDZERO
XORTOEXP STA MPINTS,Y ; RESULT INTEGERS IN MPINTS
TAX ; FIRST NONZERO RESULT -> X
LDA INTTOEXP,X
STA MPEXP,Y ; $9080 + Y
INY
LDA (LOBYTE),Y
CPY #$51
BNE XORTOEXP ; RESULT EXPONENTS IN MPEXP
DEC BYTECOUNTER ; DO ECC MATH UNTIL THERE'S 20 REMAINDERS
BEQ ECCDONE
JMP ECCSTEP2
ECCDONE ; XORRESULT CONTAINS 20 ECC BYTES
LDX #$1
LDY #$50
BUILDMSG LDA XORRESULT,X
STA STORAGE,Y
INX
INY
CPX #$16
BNE BUILDMSG ; STORAGE NOW HAS FULL 100 BYTES OF MESSAGE
RESETBYTE LDA #$0 ; SET UP FOR BYTE/BIT TRACKING
STA BYTECOUNTER
RESETBIT LDA #$8
STA BITCOUNTER
LDA #$20 ; ROW=33 (0-#$20)
STA ROW ; COLUMN=33 (0-#$20)
STA COLUMN
NEXTZIG CLC ; QRLINE=ROW/2
LDA ROW
LSR
TAX ; LINE NUM OF BLANK QR = ROW/2
LDA QRLINESLO,X
STA LOBYTE
LDA QRLINESHI,X
STA HIBYTE ; ADDRESS OF QRLINEX
LDY COLUMN ; Y=BYTE OF LINE
LDA (LOBYTE),Y ; GET THE BYTE THAT'S AT THAT SPOT IN THE QR
BCC LONIBBLE ; IT'S LATER. IF CARRY SET, THEN (HI) NIBBLE
AND #$F0 ;
CMP #$10 ; 1 IN HI NIBBLE MEANS BLANK AND READY FOR BIT
BNE ZAG
JSR SETPIXEL ; GET A BIT FROM THE MESSAGE, AND DEPOSIT INTO THE PIXEL
JMP ZAG ; DONE WITH RIGHT PIXEL, DO LEFT PIXEL
LONIBBLE AND #$0F
CMP #$01 ; 1 IN LO NIBBLE MEANS BLANK AND READY FOR BIT
BNE ZAG ; OCCUPIED?
JSR SETPIXEL ; GET A BIT FROM THE MESSAGE, AND DEPOSIT INTO THE PIXEL
ZAG DEY ; ZIG IS DONE/OCCUPIED, TIME TO ZAG - ONE COLUMN TO THE LEFT
LDA ROW ; LOST THE CARRY, SO CHECK THE ROW AGAIN
LSR
LDA (LOBYTE),Y ; GET CURRENT QR PIXEL
BCC LONIBBLE2
AND #$F0
CMP #$10 ; 1 IN HI NIBBLE MEANS BLANK AND READY FOR BIT
BNE NEXTROW
JSR SETPIXEL ; GET A BIT FROM THE MESSAGE, AND DEPOSIT INTO THE PIXEL
JMP NEXTROW
LONIBBLE2 AND #$0F
CMP #$01 ; 1 IN LO NIBBLE MEANS BLANK AND READY FOR BIT
BNE NEXTROW
JSR SETPIXEL ; GET A BIT FROM THE MESSAGE, AND DEPOSIT INTO THE PIXEL
NEXTROW LDA COLUMN ; GOING UP OR GOING DOWN? EG $20 UP $1E DOWN.
CMP #$06 ; *** EXCEPT IF THE COLUMN IS LESS THAN #$06 (TIMING PATTERN IN COL #$06)
; JFC. THIS IS COMPLICATED.
BCS DIVBY4
ADC #$1 ; CARRY CLEAR, COLUMN LESS THAN 7, ADD 1 THEN DO THE MATH
DIVBY4 LSR ; DIVIDE STARTING COLUMN BY 2
LSR ; DIVIDE AGAIN
BCS GOINGDOWN ; CARRY SET HERE MEANS GOING DOWN, CLEAR MEANS UP.
GOINGUP LDA ROW
BEQ UTURN ; TURN THE CORNER AT ROW 0
DEC ROW
LDA COLUMN
JMP NEXTZIG ;
GOINGDOWN LDA ROW
CMP #$20 ; LAST ROW?
BEQ UTURN ; TURN THE CORNER, ROW 32
INC ROW ; OTHERWISE, NEXT ROW
LDA COLUMN
JMP NEXTZIG
UTURN LDA COLUMN
CMP #$08 ; IS IT #$08? THEN SKIP THE TIMING COLUMN.
BNE CKCOLUMN
DEC COLUMN ; SKIP THE TIMING COLUMN.
CKCOLUMN CMP #$01 ; IS IT #$01? THEN WE'RE DONE HERE.
BEQ DODISPLAY
DEC COLUMN
DEC COLUMN ; TWO COLUMNS OVER FOR NEXT ZIG
LDA COLUMN
JMP NEXTZIG
DODISPLAY LDX #$0 ; COPY THE QR BYTES TO THE SCREEN.
NEXTLINE LDY #$20
LDA QRLINESHI,X ; QRLINESHI/LO,X INTO LO/HIBYTE
STA HIBYTE
LDA QRLINESLO,X
STA LOBYTE
INX ; LO RES SCREEN LO/HI INTO COLUMN/ROW
LDA LoLineTableL,X ; TARGET DOWN ONE ROW FOR WHITE SPACE AT TOP
STA ROW
LDA LoLineTableH,X
STA COLUMN
INC ROW
INC ROW ; WHITE SPACE ON LEFT
NEXTCOL LDA (LOBYTE),Y ; GET QR PIXEL
STA (ROW),Y ; STORE AT SCREEN PIXEL
DEY
BPL NEXTCOL
CPX #$11
BNE NEXTLINE
QRDONE JMP QRDONE
*** NEXTQRBYTE
NEXTQRBYTE STA MPINTS,Y ; STORE COMPLETE BYTE
LDA #$08 ; RESET LOOP COUNT
STA BITCOUNTER
INY ; NEXT QR BYTE
LDA MPINTS,Y ; INTO ACC
RTS ; BACK INTO THE FRAY
*** NEXTQRBYTE
*** SETPIXEL
SETPIXEL CMP #$01 ; ACC IS GOING TO BE EITHER 01 OR 10
BEQ SETLONIBBLE
JSR GETNEXTBIT ; LOADS TEMP WITH PROPER F OR 0
; Y HAS COLUMN OFFSET
; (LOBYTE) HAS ROW
SETHINIBBLE LDA TEMP
AND #$F0
STA TEMP
LDA (LOBYTE),Y ; GET CURRENT QR PIXEL
AND #$0F ; CLEAR HI NIBBLE
JMP SETNIBBLE
SETLONIBBLE JSR GETNEXTBIT ; LOADS TEMP WITH PROPER F OR 0
LDA TEMP
AND #$0F
STA TEMP
LDA (LOBYTE),Y ; GET CURRENT QR PIXEL
AND #$F0 ; CLEAR LO NIBBLE
SETNIBBLE EOR TEMP
STA (LOBYTE),Y ; REPLACE QR PIXEL.
RTS
*** SETPIXEL
*** GETNEXTBIT
GETNEXTBIT LDA BITCOUNTER ; WHERE WERE WE IN THE ROL SHENANIGANS?
BNE NEXTBIT ; NOT DONE WITH CURRENT BYTE
LDA #$08 ; OR ARE WE?
STA BITCOUNTER ; IF SO...
INC BYTECOUNTER ; NEXT BYTE
NEXTBIT LDX BYTECOUNTER ; ARE WE DONE WITH ALL 100 BYTES?
CPX #$64
BEQ MASKDONE
DEC BITCOUNTER
CLC
ROL STORAGE,X
BCC WHITEPIXEL
BLACKPIXEL LDA #$00
BEQ COLORPIXEL ; BRANCH ALWAYS
WHITEPIXEL LDA #$FF
COLORPIXEL STA TEMP
DOMASK ; JFC ON A POGO STICK! GOTTA MASK THE BITS!
; MASK PATTERN 1: IF (row) mod 2 == 0 THEN FLIP BIT.
LDA ROW
LSR
BCS MASKDONE ; ROW IS ODD, ALL DONE.
LDA TEMP ; ROW IS EVEN, FLIP THE BIT
BNE FLIPBIT
DEC TEMP ; TEMP IS ZERO, SET TO FF
RTS
FLIPBIT INC TEMP ; TEMP IS FF, SET TO ZERO
MASKDONE RTS
*** GETNEXTBIT
**************************************************
* blanks the screen quickly.
* CLOBBERS A,Y
**************************************************
CLEARSCREEN LDA #$FF
LDY #$78
FILL1 DEY
STA $400, Y
STA $480, Y
STA $500, Y
STA $580, Y
STA $600, Y
STA $680, Y
STA $700, Y
STA $780, Y
BNE FILL1
RTS
*** MULT45
MULT45 ; MULTIPLY BYTE IN $FC BY 45 FOR CONVERSION TO 11-BIT BINARY
; RESULT IN FE,FD
LDA #$0
STA $FD
STA $FE ; ZERO OUT TARGET BYTES
LDX #$2D ; X=45
LOOP45 CLC
LDA $FD
ADC $FC
STA $FD
BCC NEXTMULT
INC $FE
NEXTMULT DEX
BNE LOOP45
RTS
*** MULT45
DS \
QRLINE0 HEX 00,F0,F0,F0,F0,F0,00,FF,00,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,FF,00,F0,F0,F0,F0,F0,00
QRLINE1 HEX 00,FF,00,00,00,FF,00,FF,FF,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,FF,00,FF,00,00,00,FF,00
QRLINE2 HEX 00,FF,F0,F0,F0,FF,00,FF,00,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,FF,00,FF,F0,F0,F0,FF,00
QRLINE3 HEX F0,F0,F0,F0,F0,F0,F0,FF,00,1F,10,1F,10,1F,10,1F,10,1F,10,1F,10,1F,10,1F,10,FF,F0,F0,F0,F0,F0,F0,F0
QRLINE4 HEX 10,10,10,1F,1F,10,F0,1F,10,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,10,10,10,10,1F,1F,10,10
QRLINE5 HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINE6 HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINE7 HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINE8 HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINE9 HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINEA HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINEB HEX 11,11,11,11,11,11,F0,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINEC HEX F1,F1,F1,F1,F1,F1,F0,F1,01,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,00,F0,F0,F0,00,11,11,11,11
QRLINED HEX 00,F0,F0,F0,F0,F0,00,FF,0F,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,00,FF,F0,FF,00,11,11,11,11
QRLINEE HEX 00,FF,00,00,00,FF,00,FF,FF,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,10,10,10,10,10,11,11,11,11
QRLINEF HEX 00,FF,F0,F0,F0,FF,00,FF,00,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11
QRLINE10 HEX F0,F0,F0,F0,F0,F0,F0,FF,F0,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1,F1
* format string bits
* 111001011110011 - v4, Low ECC
DS \
GENERATOR HEX 00,11,3C,4F,32,3D,A3,1A,BB,CA,B4,DD,E1,53,EF,9C,A4,D4,D4,BC,BE
* 0 17 60 79 50 61 163 26 187 202 180 221 225 83 239 156 164 212 212 188 190
DS \
ALPHANUM DS 32
HEX 24,FF,FF,FF,25,26,FF,FF,FF,FF,27,28,FF,29,2A,2B,00,01,02,03,04,05,06,07,08,09,2C,FF,FF,FF,FF,FF,FF,0A,0B,0C,0D,0E,0F,10,11,12,13,14,15,16,17,18,19,1A,1B,1C,1D,1E,1F,20,21,22,23
* ASCII VAL
DS \
INTTOEXP HEX 00,00,01,19,02,32,1A,C6,03,DF,33,EE,1B,68,C7,4B,04,64,E0,0E,34,8D,EF,81,1C,C1,69,F8,C8,08,4C,71,05,8A,65,2F,E1,24,0F,21,35,93,8E,DA,F0,12,82,45,1D,B5,C2,7D,6A,27,F9,B9,C9,9A,09,78,4D,E4,72,A6,06,BF,8B,62,66,DD,30,FD,E2,98,25,B3,10,91,22,88,36,D0,94,CE,8F,96,DB,BD,F1,D2,13,5C,83,38,46,40,1E,42,B6,A3,C3,48,7E,6E,6B,3A,28,54,FA,85,BA,3D,CA,5E,9B,9F,0A,15,79,2B,4E,D4,E5,AC,73,F3,A7,57,07,70,C0,F7,8C,80,63,0D,67,4A,DE,ED,31,C5,FE,18,E3,A5,99,77,26,B8,B4,7C,11,44,92,D9,23,20,89,2E,37,3F,D1,5B,95,BC,CF,CD,90,87,97,B2,DC,FC,BE,61,F2,56,D3,AB,14,2A,5D,9E,84,3C,39,53,47,6D,41,A2,1F,2D,43,D8,B7,7B,A4,76,C4,17,49,EC,7F,0C,6F,F6,6C,A1,3B,52,29,9D,55,AA,FB,60,86,B1,BB,CC,3E,5A,CB,59,5F,B0,9C,A9,A0,51,0B,F5,16,EB,7A,75,2C,D7,4F,AE,D5,E9,E6,E7,AD,E8,74,D6,F4,EA,A8,50,58,AF
EXPTOINT HEX 01,02,04,08,10,20,40,80,1D,3A,74,E8,CD,87,13,26,4C,98,2D,5A,B4,75,EA,C9,8F,03,06,0C,18,30,60,C0,9D,27,4E,9C,25,4A,94,35,6A,D4,B5,77,EE,C1,9F,23,46,8C,05,0A,14,28,50,A0,5D,BA,69,D2,B9,6F,DE,A1,5F,BE,61,C2,99,2F,5E,BC,65,CA,89,0F,1E,3C,78,F0,FD,E7,D3,BB,6B,D6,B1,7F,FE,E1,DF,A3,5B,B6,71,E2,D9,AF,43,86,11,22,44,88,0D,1A,34,68,D0,BD,67,CE,81,1F,3E,7C,F8,ED,C7,93,3B,76,EC,C5,97,33,66,CC,85,17,2E,5C,B8,6D,DA,A9,4F,9E,21,42,84,15,2A,54,A8,4D,9A,29,52,A4,55,AA,49,92,39,72,E4,D5,B7,73,E6,D1,BF,63,C6,91,3F,7E,FC,E5,D7,B3,7B,F6,F1,FF,E3,DB,AB,4B,96,31,62,C4,95,37,6E,DC,A5,57,AE,41,82,19,32,64,C8,8D,07,0E,1C,38,70,E0,DD,A7,53,A6,51,A2,59,B2,79,F2,F9,EF,C3,9B,2B,56,AC,45,8A,09,12,24,48,90,3D,7A,F4,F5,F7,F3,FB,EB,CB,8B,0B,16,2C,58,B0,7D,FA,E9,CF,83,1B,36,6C,D8,AD,47,8E,01
XORLO db <XORRESULT
XORHI db >XORRESULT
QRLINESLO DB <QRLINE0,<QRLINE1,<QRLINE2,<QRLINE3,<QRLINE4,<QRLINE5,<QRLINE6,<QRLINE7,<QRLINE8,<QRLINE9,<QRLINEA,<QRLINEB,<QRLINEC,<QRLINED,<QRLINEE,<QRLINEF,<QRLINE10
QRLINESHI DB >QRLINE0,>QRLINE1,>QRLINE2,>QRLINE3,>QRLINE4,>QRLINE5,>QRLINE6,>QRLINE7,>QRLINE8,>QRLINE9,>QRLINEA,>QRLINEB,>QRLINEC,>QRLINED,>QRLINEE,>QRLINEF,>QRLINE10
Lo01 equ $400
Lo02 equ $480
Lo03 equ $500
Lo04 equ $580
Lo05 equ $600
Lo06 equ $680
Lo07 equ $700
Lo08 equ $780
Lo09 equ $428
Lo10 equ $4a8
Lo11 equ $528
Lo12 equ $5a8
Lo13 equ $628
Lo14 equ $6a8
Lo15 equ $728
Lo16 equ $7a8
Lo17 equ $450
Lo18 equ $4d0
Lo19 equ $550
Lo20 equ $5d0
LoLineTable DA Lo01,Lo02,Lo03,Lo04,Lo05,Lo06,Lo07,Lo08,Lo09,Lo10,Lo11,Lo12,Lo13,Lo14,Lo15,Lo16,Lo17,Lo18,Lo19,Lo20
LoLineTableH db >Lo01,>Lo02,>Lo03,>Lo04,>Lo05,>Lo06,>Lo07,>Lo08,>Lo09,>Lo10,>Lo11,>Lo12,>Lo13,>Lo14,>Lo15,>Lo16,>Lo17,>Lo18,>Lo19,>Lo20
LoLineTableL db <Lo01,<Lo02,<Lo03,<Lo04,<Lo05,<Lo06,<Lo07,<Lo08,<Lo09,<Lo10,<Lo11,<Lo12,<Lo13,<Lo14,<Lo15,<Lo16,<Lo17,<Lo18,<Lo19,<Lo20

18
qrcode.bas Normal file
View File

@ -0,0 +1,18 @@
10 HOME : PRINT "One moment..." : PRINT CHR$ (4)"BLOAD QRCO DE,A$2000"
20 VTAB 8: PRINT "This program creates and displays a": PRINT "QR code of 33 by 33 pixels.": PRINT "": PRINT "Choose an encoding type:"
30 HTAB 4: VTAB 14: PRINT "[A] for Alphanumeric.": HTAB 4: PRINT "Up to 114 characters. Limited": HTAB 4: PRINT "to upper case letters, numbers,": HTAB 4: PRINT "$ % * + - . / : and spaces."
40 HTAB 4: VTAB 19: PRINT "[B] for Bytes.": HTAB 4: PRINT "Limited to 78 ASCII characters."
50 VTAB 22: INPUT "Enter A or B :";M$
60 IF NOT (M$ = "A" OR M$ = "B" or M$="a" or M$="b") THEN GOTO 50
70 IF (M$ = "B" or M$="b") THEN POKE M$ = "B" : 8,64: GOTO 700
80 IF (M$ = "A" or M$="a") THEN M$ = "A": POKE 8,32: GOTO 800
700 HOME : VTAB 8
710 PRINT "BYTE MODE:": PRINT " Enter up to 78 ASCII characters:"
730 GOTO 1000
800 HOME : VTAB 8
810 PRINT "ALPHANUMERIC MODE:": PRINT "Enter up to 114 characters:"
820 VTAB 16: INVERSE: PRINT "Valid characters:" : PRINT "A-Z 0-9 $ % * + - . / : (space)": NORMAL
1000 VTAB 12: INPUT ">";S$
1010 if ((M$ = "A" and len(S$)>114) or (M$ = "B" and len(S$)>78)) then ? "Message too long.": goto 1000
1020 CALL 8192

BIN
qrcode.dsk Normal file

Binary file not shown.