; Gapless 48 pixel "Coke ZERO" demo ; (C) 2015 Thomas Jentzsch ; Music by Frank Scheffel ; free bytes: 2 ; Ideas: ; o utilize free cycles ; + continuous scrolling text (180 bytes, last 75 bytes repeated) ; x 2LK (requires up to 120 bytes RAM) ; x 2LK movement with 1LK graphics (requires additional 6*256 bytes ROM), looks UGLY! ; + scripting: ; + skip every 3rd row initially ; + add red band ; + add 3rd row ; + add colors ; TODOs: ; + minimize cosinus table to 65 bytes ; + fix cosinus table range when using the underlining ball ; + optimize logoIdx vs. .index ; o finalize textgraphic (maximale Höhe für "zero", Abstand hinter "zero") ; + increase graphic size to 180 (256-76) ; - remove unused assembler options + code ; + music processor 6502 LIST OFF include vcs.h LIST ON ;=============================================================================== ; A S S E M B L E R - S W I T C H E S ;=============================================================================== BASE_ADR = $f000 DEBUG = 0 ; 1 = creates debug code VERBOSE = 1 ; 1 = more verbose output during assembling MUSIC = 1 ; 1 = play music ; TV format switches: NTSC = 0 PAL60 = 0 PAL50 = 1 IF NTSC NTSC_COL = 1 NTSC_TIM = 1 ENDIF IF PAL60 NTSC_COL = 0 NTSC_TIM = 1 ENDIF IF PAL50 NTSC_COL = 0 NTSC_TIM = 0 ENDIF ;=============================================================================== ; CONSTANTS ;=============================================================================== ; constants used for fractional speed adjustments: SCANLINES_NTSC = 262 ; visible 240 SCANLINES_PAL = 312 ; visible 288 IF NTSC_TIM SCANLINES = SCANLINES_NTSC ELSE SCANLINES = SCANLINES_PAL ENDIF ;ADJUST_SPEED EQM (.. * SCANLINES / SCANLINES_PAL) LOGO_H_NTSC = 66 ; -> 198 + 19 = 217 scanlines (90% visible) LOGO_H_PAL = 76 ; -> 228 + 19 = 247 scanlines (86% visible) IF NTSC_TIM LOGO_H = LOGO_H_NTSC ELSE LOGO_H = LOGO_H_PAL ENDIF LOGO_SIZE = 180 ; = 256-LOGO_H_PAL; TODO: no NTSC logo data yet! IF NTSC_TIM TIM_VBLANK = 39 ; 64 clocks each TIM_OVERSCAN = 14 ; 76 clocks each ELSE TIM_VBLANK = 38 TIM_OVERSCAN = 22+3 ENDIF ; Coca-Cola (48 pixel) moves only +/-2 pixel! MAX_SHIFT = 2 ; +/- 2 pixel ; dPosLst constants: KERNEL_SHIFT = 0 KERNEL_MASK = %11 << KERNEL_SHIFT ; %11 LEFT_KERNEL = %01 << KERNEL_SHIFT ; %01 MID_KERNEL = %11 << KERNEL_SHIFT ; %11 RIGHT_KERNEL = %10 << KERNEL_SHIFT ; %10 EXIT_KERNEL = %00 << KERNEL_SHIFT ; %00, exits kernel loop CYCLE_SHIFT = 2 CYCLE_MASK = %11 << CYCLE_SHIFT ; %1100 CYCLE_LEFT = %00 << CYCLE_SHIFT ; %0000 CYCLE_NONE = %01 << CYCLE_SHIFT ; %0100 CYCLE_RIGHT = %11 << CYCLE_SHIFT ; %1100 ; sinus wave constants: WAVE_SPEED = $1fd * SCANLINES / SCANLINES_PAL ; 16 bit 1st cosinus wave speed WAVE2_SPEED = $0f1 * SCANLINES / SCANLINES_PAL ; 16 bit 2nd cosinus wave speed LOGO_SPEED = -$080 * SCANLINES / SCANLINES_PAL ; color constants: IF NTSC_COL RED = $40 ELSE RED = $60 ENDIF COKE_COLOR = $0e-2 COKE_COLOR_OLD = RED|$4 UNDERLINE_COLOR = RED|$4 TEXT_COLOR = $0E TEXT_BACK_COLOR = $04 ; $xf makes sure we have high contrast IF NTSC_COL XOR_COL = $8f ; $ff/$8f = both greenish, but reversed order ELSE XOR_COL = $ff ; $1f/$ff = greenish/blueish ENDIF COS_SPEED1 = $fb * SCANLINES / SCANLINES_PAL COS_SPEED2 = $17 * SCANLINES / SCANLINES_PAL CHAR_H = 13 END_FLAG = $80 ; text end flag ;=============================================================================== ; Z P - V A R I A B L E S ;=============================================================================== SEG.U variables ORG $80 xPos .byte ; current x-position on top of screen NUM_INDEXES = 5 indexLoLst ds NUM_INDEXES indexLst ds NUM_INDEXES logoIdxLo = indexLoLst waveIdxLo = indexLoLst+1 waveIdx2Lo = indexLoLst+2 cosIdx1Lo = indexLoLst+3 cosIdx2Lo = indexLoLst+4 logoIdx = indexLst ; 80..255 (79 cannot be used due to kernel limitations!) waveIdx = indexLst+1 waveIdx2 = indexLst+2 cosIdx1Hi = indexLst+3 cosIdx2Hi = indexLst+4 ; initial delay: initDelay .byte ; 76..0 delayOfs .byte ; 0..76 ; scripting: extraDelay .byte ballOfs .byte lineOfs .byte colOfs .byte ; subtitles: textOfsLo .byte ; pixel offset textOfs .byte ; points to text textIdx .byte IF MUSIC psmkPatternIdx .byte psmkTempoCount .byte psmkBeatIdx .byte ENDIF TMP_SIZE = 12 STACK_SIZE = 0 ; actually 3, but shared with tmpVars _RAM_FREE SET . ORG $100-LOGO_H - TMP_SIZE - STACK_SIZE, 0 _RAM_FREE SET . - _RAM_FREE tmpVars ds TMP_SIZE ; last 3 bytes are shared with stack stack ds STACK_SIZE dPosLst ds LOGO_H ;=============================================================================== ; M A C R O S ;=============================================================================== LIST OFF _DEBUG_BYTES SET 0 MAC DEBUG_BRK IF DEBUG _DEBUG_BYTES SET _DEBUG_BYTES + 1 brk ENDIF ENDM MAC BIT_W .byte $2c ENDM MAC SLEEP IF {1} = 1 ECHO "ERROR: SLEEP 1 not allowed !" END ENDIF IF {1} & 1 nop $00 REPEAT ({1}-3)/2 nop REPEND ELSE REPEAT ({1})/2 nop REPEND ENDIF ENDM MAC CHECKPAGE IF >. != >{1} ECHO "" ECHO "ERROR: different pages! (", {1}, ",", ., ")" ECHO "" ERR ENDIF ENDM MAC STOP_FREE _FREE SET _FREE - . ENDM MAC START_FREE _FREE SET _FREE + . ENDM MAC ALIGN_FREE_LBL LIST OFF STOP_FREE align {1} START_FREE IF VERBOSE ECHO "INFO: ALIGN_FREE ", {1}, "@", ., {2}, ":", (_FREE)d ENDIF LIST ON ENDM MAC ALIGN_FREE LIST OFF ALIGN_FREE_LBL {1}, "" ENDM MAC ORG_FREE STOP_FREE org {1} START_FREE IF VERBOSE ECHO "INFO: ORG_FREE ", {1}, "@", ., ":", (_FREE)d ENDIF ENDM MAC GET_COSINUS bpl .pos128 eor #$ff clc adc #1 .pos128 ; = 0..128 cmp #64 bcs .neg64 tay ; = 0..64 lda CosinusTbl,y bcc .pos64 .neg64 eor #$7f adc #0 ; CF == 1! tay ; = 0..64 lda #X_MAX+X_OFFSET*2+1; CF == 0! sbc CosinusTbl,y .pos64 ENDM MAC ADD_16 brk Check_{1} .byte <{1} CHECKPAGE Check_{1} .byte >{1} ENDM IF MUSIC ; include song player macros include "song_cz.h" include "SlocumPlayer22.h" ENDIF LIST ON ;=============================================================================== ; R O M - T A B L E S (1/2) ;=============================================================================== ; put here to align them SEG Bank0 ORG BASE_ADR _FREE SET 0 include "GfxData.inc" ; tables for "plasma" color animations (must NOT cross a page!) MAC COLOR_TBL COLOR SET {1} LIST ON .byte $0F^COLOR .byte $0F^COLOR .byte $0F^COLOR .byte $0F^COLOR .byte $0E^COLOR .byte $0E^COLOR .byte $0E^COLOR .byte $0D^COLOR .byte $0D^COLOR .byte $0C^COLOR .byte $0C^COLOR .byte $0B^COLOR .byte $0A^COLOR .byte $0A^COLOR .byte $09^COLOR .byte $08^COLOR .byte $08^COLOR .byte $07^COLOR .byte $06^COLOR .byte $05^COLOR .byte $05^COLOR .byte $04^COLOR .byte $03^COLOR .byte $03^COLOR .byte $02^COLOR .byte $02^COLOR .byte $01^COLOR .byte $01^COLOR .byte $01^COLOR .byte $00^COLOR .byte $00^COLOR .byte $00^COLOR .byte $00^COLOR .byte $00^COLOR .byte $00^COLOR .byte $00^COLOR .byte $01^COLOR .byte $01^COLOR .byte $01^COLOR .byte $02^COLOR .byte $02^COLOR .byte $03^COLOR .byte $03^COLOR .byte $04^COLOR .byte $05^COLOR .byte $05^COLOR .byte $06^COLOR .byte $07^COLOR .byte $08^COLOR .byte $08^COLOR .byte $09^COLOR .byte $0A^COLOR .byte $0A^COLOR .byte $0B^COLOR .byte $0C^COLOR .byte $0C^COLOR .byte $0D^COLOR .byte $0D^COLOR .byte $0E^COLOR .byte $0E^COLOR .byte $0E^COLOR .byte $0F^COLOR .byte $0F^COLOR .byte $0F^COLOR ENDM ColorTbl ; 256 values (255 would be enough) IF NTSC_COL COLOR_TBL $20^XOR_COL ; %0010 ^ %1000 = %1010 (brown/blue-green) COLOR_TBL $30^XOR_COL ; %0011 ^ %1000 = %1011 (orange/cyan) COLOR_TBL $40^XOR_COL ; %0100 ^ %1000 = %1100 (red/green-blue) COLOR_TBL $50^XOR_COL ; %0101 ^ %1000 = %1101 (pink/green) ELSE COLOR_TBL $20^XOR_COL ; %0010 ^ %1111 = %1101 (yellow/blue-purple) COLOR_TBL $40^XOR_COL ; %0100 ^ %1111 = %1011 (orange/blue) COLOR_TBL $60^XOR_COL ; %0110 ^ %1111 = %1001 (red/cyan) COLOR_TBL $80^XOR_COL ; %1000 ^ %1111 = %0111 (pink/green-blue) ENDIF ;=============================================================================== ; R O M - C O D E ;=============================================================================== ;------------------------------------------------------------------------------- Kernel SUBROUTINE ;------------------------------------------------------------------------------- .index = tmpVars+0 .tempGfx = tmpVars+1 .tempGfx2 = tmpVars+2 .dPos = tmpVars+3 ; cannot be shared with .tempGfx2 anymore due to kernel refactoring .colIndex = tmpVars+4 .ptrCos1 = tmpVars+5 ; .. +6 .ptrCos2 = tmpVars+7 ; .. +8 ; *** kernel 0 (continued) *** .kernel0R ldy .index ; 3 ldx CokeZero0,y ; 4 stx GRP0 ; 3 (= 10) .kernel0M lsr ; 2 ror ; 2 bpl .delayMR ; 2/3 bcs .delayMR ; 2/3(= 7..9) .delayMR lda CokeZero1,y ; 4 (= 4) .kernel0L ; kernel (33+3 cycles) sta GRP1 ; 3 lda CokeZero2,y ; 4 sta GRP0 ; 3 ldx CokeZero4,y ; 4 lda CokeZero5,y ; 4 ldy .tempGfx ; 3 = 21 == CokeZero3,y sty .tempGfx2 ; 3 preserve for next line (syncs graphics with pixel rows) sty GRP1 ; 3 stx GRP0 ; 3 sta GRP1 ; 3 stx GRP0 ; 3 = 15 @38..72 ; *** kernel 1 *** ; here we have 22 free cycles (+4 cycles if X is not used here) inc .colIndex ; 5 = 5 ; set HMPx: pla ; 4 sta HMP0 ; 3 sta HMP1 ; 3 sta HMBL ; 3 sta .dPos ; 3 = 16 ; update index: dec .index ; 5 = 5 == 26 cycles! ; kernel (50 cycles) ldy .index ; 3 lda CokeZero0+1,y ; 4 sta GRP0 ; 3 lda CokeZero1+1,y ; 4 sta GRP1 ; 3 lda CokeZero2+1,y ; 4 sta GRP0 ; 3 lda CokeZero3,y ; 4 this prevents using logoIdx == 79 (2/2) sta .tempGfx ; 3 = 31 prepare new 3 rows! ; ldx CokeZero4+1,y ; 4 only if X not used in between! lda CokeZero5+1,y ; 4 ldy .tempGfx2 ; 3 == CokeZero3+1,y sty GRP1 ; 3 = 10 stx GRP0 ; 3 sta GRP1 ; 3 stx GRP0 ; 3 = 9 @38..72 (8..159) ; *** kernel 2 *** ; here we have 29 free cycles (+4 cycles if X is not used here) ; animate colors: ldy .colIndex ; 3 bpl .animLine ; 2/3 ; ---------------------------------------------------------- ; here we skip various elements: ; 1. no underline, no 3rd line, no colors ; 2. no 3rd line, no colors ; 3. no colors lda #COKE_COLOR_OLD ; 2 first step only cpy ballOfs ; 3 bcc .hideUnderLine ; 2/3= 7/8 cpy lineOfs ; 3 ldy #UNDERLINE_COLOR; 2 sty COLUPF ; 3 bcc .showUnderLine ; 2/3=10/11 ; show 3rd line: lda #COKE_COLOR ; 2 used for step 3 bcs .setColors ; 3 = 5 .hideUnderLine ; 8 cmp ($00,x) ; 6 waste 6 cycles .byte $ce ; 4 opcode DEC abs .showUnderLine ; = 18 lda #COKE_COLOR-2 ; 2 used for step 2 sta COLUP0 ; 3 sta COLUP1 ; 3 = 8 lda #0 ; 2 sta GRP0 ; 3 sta GRP1 ; 3 sta GRP0 ; 3 = 11 ldy #6 ; 2 .waitCol dey ; 2 bne .waitCol ; 2/3=31 beq .endLine ; 3 = 3 ; ---------------------------------------------------------- .animLine lda (.ptrCos1),y ; 5 adc (.ptrCos2),y ; 5 this influences V-flag! tay ; 2 lda ColorTbl,y ; 4 sta COLUPF ; 3 eor #XOR_COL ; 2 = 21 .setColors sta COLUP0 ; 3 sta COLUP1 ; 3 = 6 ; kernel (43 cycles) ldy .index ; 3 this prevents using logoIdx == 79 (1/2) lda CokeZero0+1,y ; 4 sta GRP0 ; 3 lda CokeZero1+1,y ; 4 sta GRP1 ; 3 lda CokeZero2+1,y ; 4 sta GRP0 ; 3 = 24 ; lda CokeZero3-1,y ; 4 this prevents using logoIdx == 79 (2/2) ; sta .tempGfx ; 3 prepare new 3 rows! ; ldx CokeZero4,y ; 4 only if X not used in between! lda CokeZero5+1,y ; 4 ldy .tempGfx2 ; 3 == CokeZero3,y sty GRP1 ; 3 = 10 stx GRP0 ; 3 sta GRP1 ; 3 stx GRP0 ; 3 = 9 @38..72 .endLine ;|--------|38..49|50..61|62..72|XXXXXX| (@73 not used here) ; *** kernel 0 *** ; branch to kernels (left, middle, right): lda .dPos ; 3 lsr ; 2 ror ; 2 CriticalKernel bpl .rightKernel ; 2/3(= 9/10) ldy .index ; 3 ldx CokeZero0,y ; 4 stx GRP0 ; 3 bcs .middleKernel ; 2/3(= 12/13) ;.leftKernel ;21 = 21 ; free: 1 cycle lsr ; 2 ror ; 2 bpl .delayL ; 2/3 bcs .delayL ; 2/3 .delayL ; = 7..9 lda CokeZero1,y ; 4 = 4 ;--------------------------------------- sta.w HMOVE ; 4 @75..10 jmp .kernel0L ; 3 = 7 .middleKernel ;22 = 22 ; free: 0 cycles ;--------------------------------------- sta HMOVE ; 3 @75..10 jmp .kernel0M ;12+3 = 18 .rightKernel ;10 = 10 ; free: 0 cycles CHECKPAGE CriticalKernel ;--------------------------------------- sta HMOVE ; 3 @75..07/08/10/11 (+/- 4/3/2/1) bcc .exitKernel ; 2/3= 5 check unused bit 6, branches wastes 1 free cycle EnterKernel jmp .kernel0R ;22+3 = 25 ; *** additional text below demo *** ; exit kernel loop: .exitKernel .ptrGfx5 = tmpVars .ptrGfx4 = tmpVars+2 .ptrGfx3 = tmpVars+4 .ptrGfx2 = tmpVars+6 .ptrGfx1 = tmpVars+8 .ptrGfx0 = tmpVars+10 .ptrText = .ptrGfx5 sta ENABL ; 3 A == 0! sta GRP0 ; 3 sta GRP1 ; 3 sta GRP0 ; 3 = 12 ldy textIdx ; 3 lda TextPtrTblLo,y ; 4 sta .ptrText ; 3 lda #>TextTbl ; 2 sta .ptrText+1 ; 3 = 15 ldy textOfs ; 3 dey ; 2 ldx #.ptrGfx0+1 ; 2 txs ; 2 = 9 stack is restored in MainLoop .loopText ; SLEEP 3 ; 3 waste 3*6 = 18 cycles iny ; 2 bmi .showBlank ; 2/3 lax (.ptrText),y ; 5 bpl .show ; 2/3 branch if END_FLAG not set ldy #-6 ; 2 show up to 6 blanks BIT_W ; 2 .showBlank lda #__ ; 2 and #~END_FLAG ; 2 .show ; = 12/15/20 lsr ; 2 tax ; 2 lda #>CharTbl/2 ; 2 rol ; 2 get 2nd page bit pha ; 3 lda TextPtrLo,x ; 4 pha ; 3 = 18 tsx ; 2 cpx #.ptrGfx5-1 ; 2 bne .loopText ; 3/2=25/24 ; loop total: 209..220 sta WSYNC ; 3 = 3 ; total: 250..261 ;--------------------------------------- ; show top grey line and position sprites: lda #TEXT_BACK_COLOR; 2 sta COLUPF ; 3 sta COLUBK ; 3 = 8 lda #%110101 ; 2 enable priority and reflection sta CTRLPF ; 3 = 5 ldy #CHAR_H-1 ; 2 = 2 lda textOfsLo ; 3 lsr ; 2 ror ; 2 ror ; 2 ror ; 2 eor #$70 ; 2 = 13 sta HMP0 ; 3 adc #$20 ; 2 sta RESP0 ; 3 = 8 bvc .delayP1 ; 2/3 .delayP1 sta RESP1 ; 3 bvc .okP1 ; 2/3 sbc #$2f ; 2 .okP1 sta HMP1 ; 3 = 12 lda #%110 ; 2 sta NUSIZ0 ; 3 sta NUSIZ1 ; 3 = 8 lda #TEXT_COLOR ; 2 sta COLUP0 ; 3 sta COLUP1 ; 3 = 8 pla ; 4 waste 7 cycles pha ; 3 sta HMOVE ; 3 = 10 @74 ;--------------------------------------- lda #%00011000 ; 2 sta PF1 ; 3 .loopBottom lda (.ptrGfx0),y ; 5 sta GRP0 ; 3 lda (.ptrGfx1),y ; 5 sta GRP1 ; 3 lda (.ptrGfx2),y ; 5 sta GRP0 ; 3 = 24 lax (.ptrGfx5),y ; 5 lda (.ptrGfx3),y ; 5 sta GRP1 ; 3 lda (.ptrGfx4),y ; 5 sta GRP0 ; 3 dey ; 2 = 23 stx GRP1 ; 3 sta GRP0 ; 3 sta WSYNC ; 3 = 9 ;--------------------------------------- bpl .loopBottom ; 3/2= 3/2 ; show bottom grey line: iny ; 2 sty GRP0 ; 3 sty GRP1 ; 3 sty GRP0 ; 3 sty PF1 ; 3 sta WSYNC ; 3 = 17 ;--------------------------------------- sty COLUBK ; 3 bpl MainLoop ; 3 ;------------------------------------------------------------------------------- Start SUBROUTINE ;------------------------------------------------------------------------------- cld ; Clear BCD math bit. lda #0 tax txs .clearLoop: pha tsx bne .clearLoop ; GameInit ; set initial xPos (if deleted causes slight distortion at beginning): lda #228/2-2 ; == CosinusTbl, 0 sta xPos IF DEBUG ;{ STOP_FREE lda SWCHB and #$08 beq .setColOfs START_FREE ENDIF ;} lda #225+6+4 sta extraDelay dex ; X = 255 stx ballOfs stx lineOfs lda #$80 ; <= -LOGO_H-2! .setColOfs sta colOfs lda #-7 sta textOfs ; setup initial position of text: lda #LOGO_H sta logoIdx sta initDelay ; /GameInit ; falls through ;------------------------------------------------------------------------------- MainLoop SUBROUTINE ;------------------------------------------------------------------------------- ; setup sprites: lda #%110011 ; three copies close sta VBLANK sta NUSIZ1 sta NUSIZ0 sta VDELP0 sta VDELP1 sta ENABL sta CTRLPF ; disable priority ; reserve end of RAM for dPosLst (also restored after kernel here): ; this is the only place in code for doing that! ldx #dPosLst-1 txs ;------------------------------------------------------------------------------- ; OverScan ;------------------------------------------------------------------------------- ldy #TIM_OVERSCAN .waitTim: sta WSYNC dey bne .waitTim ; /OverScan ;------------------------------------------------------------------------------- ; Vertical Sync ;------------------------------------------------------------------------------- lda #%00001110 .loopVSync sta WSYNC sta VSYNC lsr bne .loopVSync ldx #TIM_VBLANK stx TIM64T ; /Vertical Sync ;------------------------------------------------------------------------------- ; VerticalBlank ;------------------------------------------------------------------------------- ; A, Y == 0! ; ***** animate the graphics ***** .tmpIdx = tmpVars+0 ; remember to keep new elements in sync with logo: lda logoIdx sta .tmpIdx ldx #logoIdxLo ADD_16 LOGO_SPEED adc #256-LOGO_H-1 ; CF == 1! (80..255) bcs .okLogo IF NTSC_TIM sbc #LOGO_H_PAL-LOGO_H_NTSC-1 ; CF == 0! difference in LOGO_H (80-70) ENDIF sta logoIdx .okLogo ; move cosinus wave(s): ADD_16 WAVE_SPEED ADD_16 WAVE2_SPEED ; move color cosinus waves: ADD_16 COS_SPEED1 sbc #MAX_COS1-1 ; CF == 0! bcc .cos1OK sta cosIdx1Hi .cos1OK ADD_16 COS_SPEED2 sbc #MAX_COS2-1 ; CF == 0! ; sbc #MAX_COS1-1 ; CF == 0! bcc .cos2OK sta cosIdx2Hi .cos2OK ; introduce new elements: lda initDelay beq .skipInitOfs ldx delayOfs inc delayOfs tya sta dPosLst-1,x .skipInitOfs ldx .tmpIdx ; -> CF == 1 cpx logoIdx beq .skipOfs lda initDelay beq .doScripting stx logoIdx dec initDelay dec delayOfs bpl .skipOfs ; unconditional ; logo has moved, so move new elements too: .doScripting lda extraDelay beq .doOfs dec extraDelay bne .endOfs .doOfs lda ballOfs beq .skipBallOfs lda #LOGO_SIZE*2-$ff+1 ; = 98 dec ballOfs jmp .checkOfs .skipBallOfs lda lineOfs beq .skipLineOfs lda #LOGO_SIZE*2-$ff dec lineOfs .checkOfs bne .endOfs sta extraDelay beq .endOfs .skipLineOfs lda colOfs beq .endOfs inc colOfs ; -128..0 .endOfs .skipOfs ; ***** create dPosLst on-the-fly ***** .dPos = tmpVars+0 .sin1 = .dPos ; move existing data: ldx #LOGO_H-1 .loopMove lda dPosLst-1,x ; 4 sta dPosLst,x ; 4 dex ; 2 bne .loopMove ; 3/2=13/12 ; 13*80 = 1040 stx dPosLst+LOGO_H-1; X == 0; set "exit kernel" marker at $ff ; calc new xPos: inx ; -> X = 1 .loopWaves sta .sin1 lda waveIdx,x ; = 0..255 GET_COSINUS dex bpl .loopWaves clc adc .sin1 ror ; average both waves lsr ; 2 values in table are doubled ; average positions: adc xPos ; 3 average x-pos to smoothen borders lsr tax ; calc dPos...: sec sbc xPos sta .dPos ; ...define HMPx...: asl asl asl asl sta dPosLst ; 3 store into list part 1/2 ; ...and set new xPos: stx xPos txa ; calc remainder: xPos % 3: sec .div3 sbc #3 bcs .div3 adc #3 ; calc kernel cycle: ldy #CYCLE_LEFT ; 2 ; sec ; 2 sbc .dPos ; 3 bmi .setCycle ; 2/3 ldy #CYCLE_NONE ; 2 cmp #3 ; 2 bcc .setCycle ; 2/3 ldy #CYCLE_RIGHT ; 2 .setCycle tya ; 2 = 10..17 ; calc kernel: ora #LEFT_KERNEL ; 2 cpx #46-1 ; 2 x = xPos bcc .setKernel ; 2/3 eor #MID_KERNEL^LEFT_KERNEL ; 2 cpx #82-1 ; 2 bcc .setKernel ; 2/3 eor #RIGHT_KERNEL^MID_KERNEL; 2 .setKernel ora dPosLst ; 3 sta dPosLst ; 3 store into list part 2/2 ; position sprites: .skipMove sta WSYNC ;--------------------------------------- txa ; 2 x = xPos clc ; 2 WaitObject sbc #$0f ; 2 bcs WaitObject ; 2³ CHECKPAGE WaitObject eor #$07 ; 2 asl ; 2 asl ; 2 asl ; 2 asl ; 2 ldy #12 ; 2 sta RESP0 ; 3 @23..! sta RESP1 ; 3 sta HMP0 ; 3 adc #$10 ; 2 sta HMP1 ; 3 sta HMBL ; 3 = 14 WaitBL dey ; 2 bne WaitBL ; 2/3 CHECKPAGE WaitBL sta RESBL ; 3 = 62 IF DEBUG ;{ STOP_FREE ; TODO: only for testing, remove later lda SWCHB lsr bcs .skipReset jmp Start .skipReset START_FREE ENDIF ;} IF MUSIC jsr PsmkPlayer ENDIF ldy textIdx ldx textOfs bne .skipStop cpy #NUM_TEXTS-1 beq .skipNextOfs ; stop the text at the end ("Cool?") .skipStop dec textOfsLo bpl .skipNextOfs inx txa sec sbc TextPtrTblLo+1,y adc TextPtrTblLo,y bmi .skipNextIdx ldx TextDelayTbl,y ; start displaying next text inc textIdx .skipNextIdx stx textOfs lda #8-1 sta textOfsLo .skipNextOfs ; /VerticalBlank ; falls through ;--------------------------------------------------------------- DrawScreen SUBROUTINE ;--------------------------------------------------------------- ; variables must be defined as in Kernel subroutine! .index = tmpVars+0 ; TODO: this one could be optimized by using logoIdx+LOGO_H-1 inside kernel .tempGfx = tmpVars+1 .colIndex = tmpVars+4 .ptrCos1 = tmpVars+5 .ptrCos2 = tmpVars+7 lda cosIdx1Hi ; 0..127 IF 0 ;{ clc adc #CosCol1Tbl sty .ptrCos1+1 lda cosIdx2Hi ; 0..89 IF 0 ;{ clc adc #CosCol2Tbl iny ENDIF sty .ptrCos2+1 ; prepare scripted display: ldy colOfs sty .colIndex ; 0..80 bpl .doAnim ldx #0 ; 2 cpy ballOfs lda #COKE_COLOR_OLD bcc .skipAnim ; 2/3 hideUnderLine ldx #UNDERLINE_COLOR; 2 cpy lineOfs ; 3 lda #COKE_COLOR ; 2 sbc #0 ; COKE_COLOR-0/1 bcs .skipAnim ; 2/3 showLine with/without gap .doAnim ; clc ; also not defined inside kernel lda (.ptrCos1),y ; 5 + 0..127 = 0..207 adc (.ptrCos2),y ; 5 + 0..89 = 0..169 tay ; 2 lax ColorTbl,y ; 4 = 18 eor #XOR_COL ; 2 .skipAnim sta COLUP0 ; 3 sta COLUP1 ; 4 stx COLUPF ; 3 = 10 .waitTim ldx INTIM bne .waitTim ; wait for data when starting demo: ldy initDelay .loopTop sta WSYNC sta WSYNC sta WSYNC ;--------------------------------------- dey ; 2 bpl .loopTop ; 2/3 sta WSYNC ;--------------------------------------- sta HMOVE ; 3 ; define start index: ldy logoIdx ; 3 sty .index ; 3 ; prepare for top row: lda CokeZero3,y ; 4 sta .tempGfx ; 3 = 16 ; coarse adjustment of kernel cycles: lda xPos ; 3 sec ; 2 LoopPos sbc #15 ; 2 bcs LoopPos ; 2/3 ; fine adjustment of kernel cycles: cmp #$f4 ; 2 bcs .waste4 ; 2/3 .waste4 cmp #$f7 ; 2 bcs .waste3 ; 2/3 .waste3 cmp #$fa ; 2 bcs .waste2 ; 2/3 .waste2 cmp #$fd ; 2 bcs .waste1 ; 2/3 .waste1 CHECKPAGE LoopPos SLEEP 2 ; 2 txa ; 2 X == 0! sta VBLANK ; 4 4 cycles free here jmp EnterKernel ; 3 = 11 ; /DrawScreen ;------------------------------------------------------------------------------- Add16 SUBROUTINE ;------------------------------------------------------------------------------- ; Y==0! .sp = dPosLst - 2 plp ; 4 clc ; 2 dec .sp ; 2 lda (.sp),y ; 2 adc $00,x ; 4 sta $00,x ; 4 inc .sp ; 2 lda (.sp),y ; 1 adc $00+NUM_INDEXES,x ; 4 sta $00+NUM_INDEXES,x ; 4 inx ; 2 rts ; 6 ; /Add16 ;=============================================================================== ; R O M - T A B L E S (2/2) ;=============================================================================== IF MUSIC PSMK_PATTERN_0 ENDIF include "CosinusTbl.h" ; 65 bytes include "CosCol1Tbl.h" ; 178 bytes IF MUSIC PSMK_PATTERN_1 ; 40 bytes PSMK_SONG_1 ; 31 bytes PSMK_PATTERNS_HI ; 22 bytes ENDIF include "CosCol2Tbl.h" ; 150 bytes .byte "JTZ" ; 3 bytes ; ****************************************************************************** ; * F O N T S + T E X T S * ; ****************************************************************************** __ = 0*2 _A = 1*2 _B = 2*2 _C = 3*2|1 ; 2nd page _D = 4*2 _E = 5*2 _F = 6*2 _G = 7*2 _H = 8*2 _I = 9*2 _J = 10*2 _K = 11*2 _L = 12*2 _M = 13*2 _N = 14*2 _O = 15*2|1 ; 2nd page _P = 16*2 ;_Q = 17*2 ; unused _R = 17*2 _S = 18*2 _T = 19*2 _U = 20*2 ;_V = 22*2 ; unused _W = 21*2 _X = 22*2 _Y = 23*2|1 ; 2nd page _Z = 24*2 _DOTS = 25*2 _QM = 26*2 _EX = 27*2 _QUOTES = 28*2 _COMMA = 29*2 _APO = 30*2 _4 = 31*2 _8 = 32*2 TextPtrLo .byte