10
20
30
40
50
60 VDU29,0;0;
70 DIM S% &FF
80 pass_number = S%
90 pattern0=S%+1
100 !pattern0=&0300
110 pattern4=S%+3
120 !pattern4=&3F00
130 pattern1=S%+5
140 !pattern1=&3F260400
150 pattern2=S%+9
160 !pattern2=&49841000
170 !(pattern2+4)=&FF6FB966
180 S%=S%+17
190 :
200 PROClimits
210 IF NOT graphics THEN PRINT"Not a graphics MODE. Can't dump.":VDU7:CHAIN"HELLO"
220 PROCassemble
230
240 VDU2,1,27,1,65,1,8
250
260 VDU 1,10,1,10,1,10
270 FOR Y%=1023 TO 0 STEP -16
280
290 VDU1,27,1,76,1,n1,1,n2
300 FOR X%=0 TO 1279 STEP step_size
310 !Xlo=X%+Y%*&10000
320 ?pass=0
330 CALL pixel
340 NEXT
350 VDU1,10
360 NEXT
370
380 VDU1,27,1,65,1,12,1,12,3
390 CHAIN"HELLO"
400 DEFPROClimits
410 A%=&87:mode=((USR&FFF4)AND&FF0000)DIV65536
420 IF mode>5 OR mode=3 THEN graphics=FALSE ELSE graphics=TRUE
430 IF mode=0 THEN n1=128:n2=2 ELSE n1=192:n2=3
440 IF mode=0 THEN step_size=2:?pass_number=1:?&80=pattern0 MOD 256:?&81=pattern0 DIV 256
450 IF mode=4 THEN step_size=4:?pass_number=3:?&80=pattern4 MOD 256:?&81=pattern4 DIV 256
460 IF mode=1 OR mode=5 THEN step_size=4:?pass_number=3:?&80=pattern1 MOD 256:?&81=pattern1 DIV 256
470 IF mode=2 THEN step_size=8:?pass_number=6:?&80=pattern2 MOD 256:?&81=pattern2 DIV 256
480 ENDPROC
490 DEFPROCassemble
500 osword=&FFF1
510 oswrch=&FFEE
520 Xlo=S%+0
530 Xhi=S%+1
540 Ylo=S%+2
550 Yhi=S%+3
560 value=S%+4
570 byte=S%+5
580 pass=S%+6
590 count_4=S%+7
600 S%=S%+8
610 FOR opt=0 TO 2 STEP 2
620 P%=S%
630 [OPT opt
640 \SUBROUTINES
650 \to calculate POINT(X,Y)
660 .point
670 ldx #Xlo MOD 256
680 ldy #Xlo DIV 256
690 lda #9
700 jmp osword
710 \subroutine to print a character
720 .printchar
730 lda #1
740 jsr oswrch
750 lda byte
760 jmp oswrch
770 \decrement Y by 4
780 .dec_Y4
790 sec
800 lda Ylo
810 sbc #4
820 sta Ylo
830 bcc dec_Yhi
840 rts
850 .dec_Yhi
860 dec Yhi
870 rts
880 \increment Y by 16
890 .inc_Y16
900 clc
910 lda Ylo
920 adc #16
930 sta Ylo
940 bcs inc_Yhi
950 rts
960 .inc_Yhi
970 inc Yhi
980 rts
990 \to rotate in two bits, Enter with X=pass, Y=colour.
1000 .two_bits
1010 lda (&80),Y \select appropriate byte of pattern
1020 cpx #0 \if pass is 0 rotate
1030 beq rotate_in \next two bits in
1040 .rotate_out
1050 ror A \otherwise dump two bits
1060 ror A
1070 dex \has X reached 0?
1080 bne rotate_out \if not dump two more
1090 .rotate_in
1100 ror A \if so next two bits go into byte
1110 rol byte
1120 ror A
1130 rol byte
1140 rts
1150 \to calculate a whole byte
1160 .one_byte
1170 jsr point
1180 ldy value
1190 lda pass
1200 and #3
1210 tax
1220 jsr two_bits
1230 jsr dec_Y4
1240 dec count_4
1250 bne one_byte \if byte incomplete go back
1260 jmp printchar \print the byte
1270 \MAIN PROGRAM
1280 \to calculate and print the pattern for one pixel
1290 .pixel
1300 lda #4
1310 sta count_4 \reset counter
1320 jsr one_byte
1330 jsr inc_Y16
1340 inc pass
1350 lda pass
1360 cmp pass_number
1370 bne pixel
1380 rts
1390 ]
1400 NEXT
1410 ENDPROC