IRF Posted July 4, 2019 Report Share Posted July 4, 2019 (edited) Your compression of the Title Screen is impressive, Norman Sword. This is small beer in the scheme of things, but instead of the commands in bold: logo_skip: INC DE LD A,D CP high +(ATT16) Jr NZ,logo_draw You could just test BIT 1, D. (And swap the conditionality of the jump to JR Z, logo_draw). Saves another byte! :) Edited July 4, 2019 by IRF Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 4, 2019 Author Report Share Posted July 4, 2019 (edited) part 4) ORG $8000 ; fixed screen referencesCHAR0 EQU $4000CHAR1 EQU $4020CHAR2 EQU $4040CHAR3 EQU $4060CHAR4 EQU $4080CHAR5 EQU $40A0CHAR6 EQU $40C0CHAR7 EQU $40E0CHAR8 EQU $4800CHAR9 EQU $4820CHAR10 EQU $4840CHAR11 EQU $4860CHAR12 EQU $4880CHAR13 EQU $48A0CHAR14 EQU $48C0CHAR15 EQU $48E0CHAR16 EQU $5000CHAR17 EQU $5020CHAR18 EQU $5040CHAR19 EQU $5060CHAR20 EQU $5080CHAR21 EQU $50A0CHAR22 EQU $50C0CHAR23 EQU $50E0 ATT0 equ $5800ATT1 equ $5820ATT2 equ $5840ATT3 equ $5860ATT4 equ $5880ATT5 equ $58a0ATT6 equ $58c0ATT7 equ $58e0ATT8 equ $5900ATT9 equ $5920ATT10 equ $5940ATT11 equ $5960ATT12 equ $5980ATT13 equ $59a0ATT14 equ $59c0ATT15 equ $59e0ATT16 equ $5a00ATT17 equ $5a20ATT18 equ $5a40ATT19 equ $5a60ATT20 equ $5a70ATT21 equ $5aa0ATT22 equ $5ac0ATT23 equ $5ae0 ;fixed hardware INKSBLACK EQU 0BLUE EQU 1RED EQU 2MAGENTA EQU 3GREEN EQU 4CYAN EQU 5YELLOW EQU 6WHITE EQU 7 ;hardware colour controlBRIGHT EQU 64FLASH EQU 128 ;================================================= start: call draw_bottom_att call draw_logo hang: jr hang ;========================================================================draw_bottom_att: ld de,ATT16 ld ix,bottom_att ld hl,bottom_translate jp expand ;=======================================================================; this draws the attributes for the logo;; Slight change in data that is needed for the expansion of the ATT data;; If the ink flashes or the ink and paper are the same colour then no graphic overlay;; graphic "\" := no bright then set as a "\" graphic;; graphic "/" := bright then set as "/" graphic and delete the bright; draw_logo: ld de,ATT0 ld ix,new_logo_dat ld hl,new_logo_translate ld a,$07 ld (S_M_C_double),a ;an rlca call expand xor a ;the nop opcode ld (S_M_C_double),a ;---------------------------------------------- ; now draw the text on top of the logo ld hl,ATT0 ld de,logo_overlay ld c,FLASH+RED+8*YELLOW ; this can be changed to any flashing colour combination, with differing ink colours text ld a,(de) cp 255 jr z,graphic ld b,8 ;width of data bytetext1: rlca ;bit out jr nc,clear ld (hl),cclear: inc hl djnz text1 inc de jr textgraphic: ;---------------------------------------logo_graphics:; this part adds the graphics LD DE,ATT0 ; 8841 ;$5800logo_draw: LD A,(DE) ;L8844; if ink=paper then ignore or if the flash bit is set then ignore;$00,$09,$2d,$24 skip ink=paper; d3 skip flashing tile bit 7,a jr nz,logo_skip ;flashing is the text overlay ld c,a rrca rrca rrca ; rotate paper bit down to ink bits position xor c and 7 jr z,logo_skip ; these are the solid squares ld a,c ; ; NEXT GROUP if bright one way else other; NOTE the odd value $2c which was changed to $25, this has had its source data changed to $25. ;The other $25's,'s now have bright added;"\" $08,$29,$2c,$05;"/" the rest all have bright now set ld hl,triangle_udg ; set graphics to use bit 6,a ; the bright jr z,logo1_graphic ld hl,triangle_udg+16 and 10111111b ; remove the bright ld (de),a logo1_graphic: ld a,e ; Offset by eight bytes if the position on screen is odd rlca rlca rlca and 8 ; Extract the offset call index1 ; add a to hl returns a=(a+hl) ;ignore the return "a" ld c,d ; save the position HIGH; Bit 0 in 'd' indicates top or bottom half of screen BIT 0,D ; 8880 ; Set the zero flag if we're still in the top third of the attribute file LD D,high CHAR0 ; 8882 ;$40 Point DE at the top third of the display file JR Z,L8888 ; 8884 ; Jump if we're still in the top third of the attribute file LD D,high CHAR8 ; 8886 ;$48 Point DE at the middle third of the display fileL8888: CALL printing_char ; ; Draw a triangle UDG on the screen ld d,c ; ; restore position HIGHlogo_skip:;move to next cell, and check if at the end of the area we are changing INC DE ;L888E ; Point DE at the next byte in the attribute file LD A,D ; 888F ; Have we finished scanning the top two-thirds of the attribute file yet? CP high +(ATT16) ; 8890 ;$5A Jr NZ,logo_draw ; 8892 ;L8844 If not, jump back to examine the next byte ret ;======================================================================== ; sub routine to expand dataexpand: ld (S_M_C_translate),hldraw_logo_loop: ld a,(ix) inc ix cp 255 ret zS_M_C_translate: equ $+1 ld hl,$-$ call indexer draw_in ld (de),a inc de djnz draw_in jr draw_logo_loop ;======================================================================= ; expand subroutine - find run length and data to writeindexer: ld c,a and $f0 rrca rrca rrca rrca inc a;next opcode changed for double run lengthS_M_C_double: equ $ nop ;opcode 07 for rlca ld b,a ld a,c and 15 ; - index into hl via "a" and return (hl+"a") in "a" ; general subroutine index1: add a,l ld l,a adc a,h sub l ld h,a ld a,(hl) ret ;=============================== all the logo data ======================= new_logo_translate:; 0 1 2 3 4 5 6 7 8 9 A B C DDB 0,$68,$05,$2D,$65,$24,$04,$4C,$09,$08,$29,$25,$2C,$44 new_logo_dat:DB $F0DB $F0DB $80, $01, $02DB $c0, $01,$03,$04DB $b0, $01,$03,$04,$05DB $a0, $01, $03, $04, $15DB $90, $01,$03,$04,$05,$07,$05DB $80, $01,$03,$04,$05,$0d,$08,$05DB $80, $0a,$03,$0b,$0D,$00,$08,$05DB $80, $08,$0A,$03,$02,$00,$08,$05DB $80, $09,$08,$0A,$03,$02,$08,$05DB $90, $09,$08,$0A,$03,$08,$05DB $a0, $09,$08,$0A,$08,$05DB $b0, $09,$08,$08,$05DB $c0, $09,$08,$05DB $d0, $09,$0d,$40DB $Ff ;teminator logo_overlay db 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00100010b,11111000b,10001111b,00011110bdb 00100010b,10001001b,01001000b,10100000bdb 00111110b,11100010b,00101000b,10011100bdb 00100010b,10001011b,11101000b,10000010bdb 00100010b,11111010b,00101111b,00111100bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000bdb 00000000b,00000000b,00000000b,00000000b db $ff ; manual inspection for value ;======================================================================= bottom_translate:; 0 1 2 3 4 5 6 7 8 9 a b c d e fdb 0,$01,$02,$03,$04,$05,$06,$07,$46,$45,$41,$43,$44 bottom_attdb $f8,$f8db $f0,$f0db $f0,$f0db $01,$02,$03,$04,$05,$06,$97,$97,$06,$05,$04,$03,$02,$01db $f0,$f0db $19,$16,$14,$1a,$15,$1b,$1c,$10,$f0db $19,$16,$14,$1a,$15,$1b,$1c,$10,$f0db $f0,$f0db $ff ;------------------------------------------------------------------------ ; these bits of data and code are needed to assemble ; the printing_char routine is part of the games normal print routine. ;8431 Triangle UDGstriangle_udg:;'\'DEFB $C0,$F0,$FC,$FF,$FF,$FF,$FF,$FF ;L8431DEFB $00,$00,$00,$00,$C0,$F0,$FC,$FF ; 8439;'/'DEFB $FF,$FF,$FF,$FF,$FC,$F0,$C0,$00 ; 8441DEFB $FC,$F0,$C0,$00,$00,$00,$00,$00 ; 8449 This part is part of the games print text. printing_char:LD B,$08 ; 9699 ; There are eight pixel rows in a character bitmap;This entry point is used by the routine at L87CA to draw a triangle UDG on the title screen, and by the routine at L93D1; to draw an item in the current room.print_char: ;L969bLD A,(HL) ;L969B ; Copy the character bitmap (or triangle UDG, or item graphic) to the screen (or screen buffer)LD (DE),A ; 969C ;INC HL ; 969D ;INC D ; 969E ;DJNZ print_char ; 969F ;L969bRET ; 96A1 ; end start ; everything from above assembles into $1AB of code and data. Just the original data was $300 ** NOTE ** proportional spaced font has destroyed the layout of this data and code. I have slightly redone the layout. Edited July 8, 2019 by Norman Sword Spider and IRF 2 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 4, 2019 Author Report Share Posted July 4, 2019 Having spent longer writing about what I did than I took to write the code. I will add that this is not how I normally draw the logo triangle. I still prefer the code I created that allows me to scale the logo to any size I need. That code is nothing like the code above. Spider and IRF 2 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 4, 2019 Author Report Share Posted July 4, 2019 (edited) In response to post #11, how to save a byte.I did wonder why the check was done in such a manner. And went back to the original listed source code. This was an edit of the original source code, and A Mr Matthew Smith chose that method originally, and I just left it. If I was to go through all this code, I have already thought of some areas of code that could be changed. Like a dog chasing its tail, each look draws attention to something else and each change draws attention to something else.Next the clock part 5)Typo manor instead of manner.... changed Edited July 4, 2019 by Norman Sword IRF 1 Quote Link to comment Share on other sites More sharing options...
IRF Posted July 4, 2019 Report Share Posted July 4, 2019 in such a manor. Deliberate typo, m'lud? Spider 1 Quote Link to comment Share on other sites More sharing options...
IRF Posted July 4, 2019 Report Share Posted July 4, 2019 Typo manor instead of manner.... changed I thought it might be a deliberate reference to Willy's grand abode... Spider 1 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 6, 2019 Author Report Share Posted July 6, 2019 Cheat code entry:- keyport equ $FE ; this will sit from $8b70 to $8bCd 51(approx) bytes shorter ; original $8b70 to $8c01 ; Here we check the teleport keys. ;CODE FROM $8B70 re arranged and re written teleport_check: ld hl,cheat ld a,(hl) cp 10 jr nz,check_for_cheat ld a,$ef in a,(keyport) BIT 1,A JR NZ,LA_HOP AND $10 XOR $10 RLCA LD B,A ld a,$f7 in a,(keyport) CPL AND $1F OR B LD (current_room),A JP enter_new_room check_for_cheat: LD A,(current_room) CP $1C JR NZ,LA_HOP LD A,(willy_y) sub $d0 JR NZ,LA_HOP ld b,a LD a,(HL) add a,a EX DE,HL ld c,a LD HL,cheat_table add hl,bc ld bc,$21f ld a,$fb cheat_read: in a,(keyport) and c CP (HL) JR NZ,check_cheat2 INC HL ld a,$df djnz cheat_read EX DE,HL INC (HL)LA_HOP: JP main_loop check_cheat2: cp c JR Z,LA_HOP DEC HL DEC HL CP (HL) JR Z,LA_HOP EX DE,HL LD (HL),0 JR LA_HOP - saving around 51 bytes- see source code listing for the references jetsetdanny, Spider and IRF 3 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 6, 2019 Author Report Share Posted July 6, 2019 (edited) ;8D33: Draw the current room to the screen buffer at 7000 ; this $8d33 to $8d9a (50 bytes approx shorter) ; original $8d33 to $8dd3 ; No attribute errors- draws exactly what is specified. ; the tile printed is the tile specified (in every case) ; routine executes a lot faster draw_room: ;L8D33 ; start by defining each of the six types into the master attribute area;e.g. place 0=backround 1=floor,2=wall 3=nasty,4=ramp 5=conveyor into the master attribute area ;first part, expand the lower compacted data for the four types LD HL,room_layout ;Point HL at the first room layout byte at L8000 LD de,att_master ;Point IX DE at the first byte of the attribute buffer at 5E00mosaic: ld a,(hl) ld b,4tile_it: rlca rlca ld c,a and 3 ld (de),a ld a,c inc de djnz tile_it inc l bit 7,l jr z,mosaic;Next consider the conveyor tiles (if any).;draw_conveyor LD A,(conv_len) ; 8D90 ;L80D9 Pick up the length of the conveyor from L80D9 OR A ; 8D93 ; Is there a conveyor in the room? JR Z,draw_ramp ; 8D94 ;L8DA1 Jump if not LD HL,(conv_add) ; 8D96 ;L80D7 Pick up the address of the conveyor's location in the attribute buffer at 5E00 from L80D7 LD B,A ; 8D99 ; B will count the conveyor tilesL8D9D: LD (HL),5 ;L8D9D ; Copy the attribute bytes for the conveyor tiles into the buffer at 5E00 INC HL ; 8D9E ; DJNZ L8D9D ; 8D9F ; ;And finally consider the ramp tiles (if any).draw_ramp: LD A,(ramp_len) ;L8DA1 ;L80DD Pick up the length of the ramp from L80DD OR A ; 8DA4 ; Is there a ramp in the room? jr Z,tile_grout ld b,a LD HL,(ramp_add) ; 8DA6 ;L80DB Pick up the address of the ramp's location in the attribute buffer at 5E00 from L80DB LD A,(ramp_dir) ; 8DA9 ;L80DA) Pick up the ramp direction from L80DA; A=0 (ramp goes up to the left) or 1 (ramp goes up to the right) and 1 ; 0 or 1 rlca ; 0 or 2 sub $21 ; -$21 or -$1f ld e,a LD D,$FF ; 8DB2 ; L8DBB: LD (HL),4 ;L8DBB ; Copy the attribute bytes for the ramp tiles into the buffer at 5E00 ADD HL,DE ; 8DBC ; DJNZ L8DBB ; 8DBD ; ; now draw the tiles; take the six defined types and expand into the tile- 100% garanteed the correct definitiontile_grout: LD IX,att_master ; 8D36 ;$5E00 Point IX at the first byte of the attribute buffer at 5E00 ld de,char_mastertile_do: ld a,(ix) ld c,a add a,a add a,a add a,a add a,c ;*9 add a,low back_tile ld l,a ld h,high back_tile ld a,(hl) ;tile colour ld (ix),a inc ix ;Crosses page boundary at mid point inc l ld c,d call printing_char ;copies data from (hl) to (de):- SCREEN MAPPED see source code for address ld a,d ld d,c inc e jr nz,tile_do ;at this point we cross the page boundary ld d,a cp high +(char_master+$1000) jr nz,tile_do ret saving around 50 bytes - see source listing for references Edited July 7, 2019 by Norman Sword Spider, jetsetdanny and IRF 3 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 6, 2019 Author Report Share Posted July 6, 2019 (edited) ; update the clock originally at $8a52 to $8aaa This routine is approx 74 bytes, 14 (approx) bytes smaller ld de,mess_time+4 ld hl,clock_master+4update_clock: ld a,(de) cp ":" jr z,clock_colon: cp " " jr nz,valid_dig ld a,"0"valid_dig: inc a ld (de),a dec a cp (hl) ; are we at max yet jr nz,clock_out ld a,"0" ld (de),aclock_colon: dec hl dec de jr update_clock ; clock_master: DB "29:59"am_2_pm equ "a" xor "p" ; ;do we need to adjust output ; check 1 is from 11:59 am to 12:00pm ;- toggle am/pm; check 2 is from 12:59 am to 13:00 ; reset to 1:00 clock_out: ex de,hl ld a,l ; which char was last updated cp low +(mess_time+1) jr nz,clock_updated;we have just updated unit part of the hour (10:00 change updates the tens part) dec hl ld a,"1"; is the hour 1x:00 ? cp (hl) ; it all happens on either 12:00 or 13:00, so is the "1" present jr nz,clock_updated; hour can be 11:00, 12:00 or even 13:00 - see comment above on 10:00 inc hl inc a ; change to "2"; check for 12:00 cp (hl) JR Z,MIDNIGHT ; just gone 12:00 INC A ; change to "3";check for 13:00 CP (HL) JR NZ,clock_updated; clock now says 13:00, so reset to 1:00 ld hl,$3120 ; " 1" NOTE LS MS switch ld (mess_time),hl jr clock_updated ; clock is on midnight/noon change am to pm and pm to amMIDNIGHT: ld hl,mess_time+5 ld a,(hl) xor am_2_pm ;toggle the am/pm ld (hl),a; if this extra check to abort the game at midnight was not done, we could carry on. The clock has been correctly changed to am cp "a" ; the midnight change jp z,game_over_time ; >>> this can go to the boot routine - game over etc. clock_updated: Routine is smaller and changes from am to pm/ and pm to am- at 12:00am and 12:00pm routine aborts game at midnightpossible to chop bytes from the code- clarity suffers greatly for such small changes Edited July 9, 2019 by Norman Sword Spider, IRF and jetsetdanny 3 Quote Link to comment Share on other sites More sharing options...
Norman Sword Posted July 6, 2019 Author Report Share Posted July 6, 2019 (edited) original code at $8ce3 to $8d33 ; approx figures ; this routine in 38 (approx) byes - the original was 77(approx) byes saving 39(approx) bytes LD BC,$0000 ; 8CE3 ; B=delay, c=Colour LD D,$06 ; 8CE6 ; d=major loop counter delay: DJNZ delay ;L8CE8 ;L8CE8 Delay for about a millisecond delay djnz delay call TWINKLE dec c jr nz,delay dec d jr nz,delay jp display_title TWINKLE ld a,c ld hl,ATT6+10 CALL TWINK LD L,LOW +(ATT6+18)TWINK: LD B,4TWINK1: INC A AND 7 OR BRIGHT LD (HL),A INC L DJNZ TWINK1 RET See original source listing for references Edited July 8, 2019 by Norman Sword IRF, jetsetdanny and Spider 3 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.