John B. Matthews, M.D.

Return home.


Download an Apple II disk image of miscellaneous code (.tgz).
Download the same disk image as a ShrinkIt disk archive (.sdk).
Download J. H. Van Ornum's 6502 cross-assembler for Mac OS X.
Download Marko Makela's 6502 cross-disassembler for Mac OS X.

Apple II stuff.

Here are some links to a few of my favorite Apple II projects:
The disk image above contains source and object code for a few of my favorite assembly language, Pascal and Basic programs from bygone days. Here are a few samples.
Using the monitor in Kyan Pascal

Steve Wozniak's monitor is a familiar tool for debugging in Basic and Assembler. The ProDOS "mtr" command (or call -151) brings up a reassuring '*' prompt. I missed this feature in Kyan's Kix command line, so I wrote one. It hooks into control-Y, so you can easily return to the Kix prompt (%). Just run this code through AS and store the resulting binary in the Kix "bin" directory to create your own "mtr" command. It runs at $380, so it won't overwrite a previously loaded program.
;Enter monitor from Kix; J. Matthews; 26-Jul-03; GPL.
 org $380
usradr equ $03F8 ;control-Y vector
mli    equ $BF00
crout  equ $FD8E
cout   equ $FDED
monz   equ $FF69
 ldx #2 ;install control-Y vector
install lda vec,x
 sta usradr,x
 dex
 bpl install
 jsr crout
 ldy msg
 ldx #1
print lda msg,x
 ora #$80
 jsr cout
 inx
 dey
 bne print
 jsr crout
 jmp monz
msg str 'Enter control-Y to resume.'
vec jmp exit
exit jsr mli
 db $65
 dw qlist
qlist db 4,0,0,0,0,0,0
This is pure assembly language, with no Kyan library loaded. There's not much to see, but it's handy for looking around ProDOS, tracing other code or doing a quick hex conversion.

More interestingly, it's possible to use the monitor to debug Pascal, as shown below. Each time the program does a "jsr break", it enters the monitor. Control-Y resumes normal execution until the next break, or the program ends. Zero page locations 4 and 5 hold the Kyan stack pointer, which grows downward from $9000, so you can use monitor commands to examine your stack variables. Locations $3F9 and $3FA hold the return address - 1, so you can examine your running code.
program DebugTest;

const MaxString = 16;
type String = array [1..MaxString] of char;
var s, t: String;

procedure SetDebug;
begin
#a
usradr equ $03F8 ;control-Y vector
monz   equ $FF69 ;monitor entry
 lda #$4C
 sta usradr
 lda #>resume
 sta usradr+1
 lda #<resume
 sta usradr+2
#
end;
#a
break stx xreg
 pla
 sta pc
 pla
 sta pc+1
 jmp monz
resume ldx xreg
 lda pc+1
 pha
 lda pc
 pha
 rts
xreg db 0
pc   dw 0
#

begin
  SetDebug;
  s := '****************';
  t := '0123456789ABCDEF';
  writeln(s, t);
#a
 jsr break
#
  s := t;
#a
 jsr break
#
  writeln(s, t);
end.
An hd command for Kix in Kyan Pascal

Although the Kyan Kix 'cat' command can produce a primitive hex dump for non-text files, I wanted something that could dump any file in both hex and ASCII. This version uses no parameters, but you can specify more than one file (or directory!) in the same command courtesy of the parseline function supplied by Kyan.
{10-Jul-03; J. Matthews; GPL}

program HD;

const MaxString = 127;
type String16 = array [1..16] of char;
     String127 = array [1..MaxString] of char;
     StrPointer = ^StrRecord;
     StrRecord = record
       StrFound: String127;
       NextStr: StrPointer
     end;
var sp: StrPointer;

#i other.lib/parseline.i

procedure HexByte(b: integer);
begin
#a
prbyte equ $FDDA
 stx _t
 lda #$A0 ;space
 jsr cout
 ldy #5
 lda (_sp),y
 jsr prbyte
 ldx _t
#
end;

procedure HexWord(w: integer);
begin
#a
 stx _t
 ldy #6
 lda (_sp),y
 jsr prbyte
 dey
 lda (_sp),y
 jsr prbyte
 lda #$BA ;colon
 jsr cout
 ldx _t
#
end;

procedure Dump(name: String127);
var f: file of char;
    i, j, k: integer;
    s: String16;
begin
  i := 1; j := 0;
  reset(f, name);
  while not eof(f) do begin
    if i = 1 then HexWord(j);
    k := ord(f^);
    if (k > 31) and (k < 128) then
      s[i] := chr(k)
    else s[i] := '.';
    HexByte(k);
    i := i + 1;
    if i > 16 then begin {line break}
      writeln(' ', s);
      i := 1;
      j := j + 16
    end;
    get(f);
  end;
  if i > 1 then begin {partial line}
    for k := i to 16 do write('   ');
    write(' ');
    for k := 1 to i - 1 do write(s[k]);
    writeln
  end
  else writeln
end;

begin
  sp := ParseLine;
  sp := sp^.NextStr; {skip command name}
  while sp <> nil do begin
    Dump(sp^.StrFound);
    sp := sp^.NextStr
  end
end.
A df command for Kix in Kyan Pascal

Here's a 'df' command for the Kix command-line environment of Kyan Pascal. The program finds how much space is free on all mounted volumes; a similar result can be obtained in Kix with the 'ls -l /' command. The program uses the ProDOS MLI On_Line command ($C5) to find all mounted volumes. It then reads the directory header (block 2) to determine the volume's size. It also examines the volume bit map to find how much space is free. I especially like how easy it is to mix Pascal and assembly language. The version on the disk (above) was compiled as a system file, so you can run it even without Kix.
{25-Jul-03; J. Matthews; GPL}

program DF; {disk free space}

type VolumeName = array [0..15] of char;
     VolumeNameArray = array [0..15] of VolumeName;
     Buffer = array [0..511] of char;
var  vna: VolumeNameArray;
     buf: Buffer;
     i, j, free, total, sumFree, sumTotal, sumVol,
     unit, slot, drive, length: integer;

function BlockRead(u, b: Integer; var buf: Buffer): integer;
begin
  BlockRead := 0;
#a
 ldy #7      ;buffer address
 lda (_sp),y
 sta blist+2
 iny
 lda (_sp),y
 sta blist+3
 iny         ;block number
 lda (_sp),y
 sta blist+4
 iny
 lda (_sp),y
 sta blist+5
 iny         ;unit number
 lda (_sp),y
 sta blist+1
 jsr _mli    ;read_block
 db  $80
 dw  blist
 ldy #5      ;return error code
 sta (_sp),y
#
end;
#a
blist db 3,0,0,0,0,0
#

procedure OnLine(var v: VolumeNameArray);
begin
#a
 ldy #5      ;address of buffer
 lda (_sp),y
 sta onlist+2
 iny
 lda (_sp),y
 sta onlist+3
 jsr _mli
 db  $C5     ;on_line
 dw  onlist
#
end;
#a
onlist db 2,0,0,0
#

function BitCount(var buf: Buffer): integer;
begin
  BitCount := 0;
#a
bptr equ _t
sum  equ bptr+2
xsav equ sum+2
 stx xsav
 lda #0
 sta sum    ;init sum
 sta sum+1
 ldy #7     ;init buffer ptr
 lda (_sp),y
 sta bptr
 iny
 lda (_sp),y
 sta bptr+1
 jsr count  ;first half
 inc bptr+1
 jsr count  ;and second
 ldy #5     ;store result
 lda sum
 sta (_sp),y
 iny
 lda sum+1
 sta (_sp),y
 ldx xsav
#
end;
#a
count ldy #0 ;count a page
loop lda (bptr),y
 beq count2  ;skip 0
 cmp #$FF
 bne count1
 lda #8
 bne add
count1 ldx #0
nxtbit lsr
 pha
 bcc skip
 inx
skip pla
 bne nxtbit
 txa
add clc      ;running total
 adc sum
 sta sum
 bcc count2
 inc sum+1
count2 iny
 bne loop
 rts
#

procedure FreeCount(u: integer; var f, t: integer; var buf: Buffer);
  var i, firstMap, lastMap: integer;
begin
  f := 0; t := 0;
  if BlockRead(u, 2, buf) = 0 then begin
    firstMap := ord(buf[39]) + (ord(buf[40]) * 256);
    t := ord(buf[41]) + (ord(buf[42]) * 256);
    lastMap := firstMap + (t div 4096);
    for i := firstMap to lastMap do
      if BlockRead(u, i, buf) = 0 then
        f := f + BitCount(buf)
  end
end;
 
procedure Decode(u: integer; var s, d, l: integer);
begin
  s := (u div 16) mod 8;
  d := (u div 128) + 1;
  l := u mod 16;
end;

begin
  sumFree := 0; sumTotal := 0; sumVol := 0;
  OnLine(vna);
  Writeln('Volumes on-line:         free/total');
  Writeln('----------------         ----------');
  for i := 0 to 15 do begin
    unit := ord(vna[i, 0]);
    Decode(unit, slot, drive, length);
    if length <> 0 then begin
      sumVol := succ(sumVol);
      FreeCount(unit, free, total, buf);
      sumFree := sumFree + free;
      sumTotal := sumTotal + total;
      Write('S', slot, ',D', drive, ': /');
      for j := 1 to length do Write(vna[i, j]);
      for j := length to 16 do Write(' ');
      Writeln(free, '/', total)
    end
  end;
  Writeln;
  Write(sumFree, '/', sumTotal, ' blocks free on ');
  Writeln(sumVol, ' volumes.')
end.
Lo-res Library

A lo-res library for Kyan Pascal. Note that the 'plot' routine is optimized to use a lookup table rather than the monitor's 'gbascalc' code. The example
below uses this code.
{07-Jul-03; J. Matthews; GPL}

{Set lo-res graphics, mixed mode, 40 column text}
procedure Gr;
begin
#a
gbasl  equ $26
h2     equ $2C
v2     equ $2D
mask   equ $2E
color  equ $30
plot1  equ $F80E
hline1 equ $F81C
scrn2  equ $F879
settxt equ $FB39
setgr  equ $FB40
home   equ $FC58
 stx _t
 lda #$11
 jsr cout
 jsr setgr
 jsr home
 ldx _t
#
end;

{Set lo-res graphics, 80 col text}
procedure Gr80; 
begin
#a
 stx _t
 lda #$12
 jsr cout
 jsr setgr
 ldx _t
#
end;

{Set text mode, 80 column}
procedure Tx;
begin
#a
 stx _t
 jsr settxt
 lda #$12
 jsr cout
 ldx _t
#
end;

{Set color, 0 to 15}
procedure Color(c: integer);
begin
#a
 ldy #5
 lda (_sp),y
 and #$0F
 sta color
 asl a
 asl a
 asl a
 asl a
 ora color
 sta color
#
end;

{Plot x, y with current color}
procedure Plot(x, y: integer);
begin
#a
 stx _t
 ldy #5
 lda (_sp),y
 sta _t+1
 ldy #7
 lda (_sp),y
 tay
 lda _t+1
 jsr plot
 ldx _t
#
end;

{Get color of screen at x, y}
function Scrn(x, y: integer): integer;
begin
Scrn := 0;
#a
 stx _t
 ldy #7
 lda (_sp),y
 sta _t+1
 ldy #9
 lda (_sp),y
 tay
 lda _t+1
 jsr scrn
 ldy #5
 sta (_sp),y
 ldx _t
#
end;

{Replace 'gbascalc' with lookup table}
#a
plot lsr
 tax
 lda basl,x
 sta gbasl
 lda bash,x
 sta gbasl+1
 lda #$0F
 bcc setmask
 lda #$F0
setmask sta mask
 jmp plot1
hline jsr plot
 jmp hline1
vlinez adc #1
vline pha
 jsr plot
 pla
 cmp v2
 bcc vlinez
rts1 rts
scrn lsr
 tax
 lda basl,x
 sta gbasl
 lda bash,x
 sta gbasl+1
 lda (gbasl),y
 jmp scrn2
basl db $00,$80,$00,$80,$00,$80,$00,$80
 db $28,$A8,$28,$A8,$28,$A8,$28,$A8
 db $50,$D0,$50,$D0,$50,$D0,$50,$D0
bash db $04,$04,$05,$05,$06,$06,$07,$07
 db $04,$04,$05,$05,$06,$06,$07,$07
 db $04,$04,$05,$05,$06,$06,$07,$07
#

{Horizontal line from x1 to x2 at y}
procedure HLine(x1, x2, y: integer);
begin
#a
 stx _t
 ldy #5
 lda (_sp),y
 sta _t+1
 ldy #7
 lda (_sp),y
 sta h2
 ldy #9
 lda (_sp),y
 tay
 lda _t+1
 jsr hline
 ldx _t 
#
end;

{Vertical line from y1 to y2 at x}
procedure VLine(y1, y2, x: integer);
begin
#a
 stx _t
 ldy #9
 lda (_sp),y
 sta _t+1
 ldy #7
 lda (_sp),y
 sta v2
 ldy #5
 lda (_sp),y
 tay
 lda _t+1
 jsr vline
 ldx _t
#
end;

{Return true if key pressed, character in ch}
function KeyPress(var ch: char):boolean;
begin
 KeyPress := false;
#a
 bit $C000
 bpl nokey
 ldy #6
 lda (_sp),y
 sta _t
 iny
 lda (_sp),y
 sta _t+1
 lda $C000
 and #$7F
 ldy #0
 sta (_t),y
 sta $C010
 ldy #5
 lda #1
 sta (_sp),y
nokey
#
end;
Rod's Color Pattern from the Red Book

Rod's Color Pattern, written in Basic by Randy Wigginton, originally appeared on page 55 of the Red Book distributed by Apple Computer, Inc. circa 1978. Running in just 4K of RAM, it was described as "a simple but eloquent program. It generates a continuous flow of colored mosaic-like patterns in a 40 high by 40 wide block matrix. Many of the patterns generated by this program are pleasing to the eye and will dazzle the mind for minutes at a time."
 10  GR : ONERR GOTO 99
 20  FOR W = 3 TO 50
 30  FOR I = 1 TO 19
 40  FOR J = 0 TO 19
 50  K = I + J
 60  COLOR= J * 3 / (I + 3) + I * W / 12
 70  PLOT I,K: PLOT K,I: PLOT 40 - I,40 - K: PLOT 40 - K,40 - I
 80  PLOT K,40 - I: PLOT 40 - I,K: PLOT I,40 - K: PLOT 40 - K,I
 90  NEXT : NEXT : NEXT : GOTO 20
 99  TEXT : HOME : END
Rod's Color Pattern in Java

Faster: In the ensuing years, the program has been migrated to other languages and platforms. Here's the same program in Java, adapted by David Schmenk to run on his virtual machine for the Apple II.
import apple2.*;

public class Rod {

    public static void main(String args[]) {

        int i, j, k, w, fmi, fmk, color;
       
        AppleStuff.loRes();
        while (true) {
            for (w = 3; w <= 50; ++w) {
                for (i = 1; i <= 19; ++i) {
                    for (j = 0; j <= 19; ++j) {
                        k = i + j;
                        color = (j * 3) / (i + 3) + i * w / 12;
                        fmi = 40 - i;
                        fmk = 40 - k;
                        AppleStuff.lrColor(color);
                        AppleStuff.lrPlot(i, k);
                        AppleStuff.lrPlot(k, i);
                        AppleStuff.lrPlot(fmi, fmk);
                        AppleStuff.lrPlot(fmk, fmi);
                        AppleStuff.lrPlot(k, fmi);
                        AppleStuff.lrPlot(fmi, k);
                        AppleStuff.lrPlot(i, fmk);
                        AppleStuff.lrPlot(fmk, i);
                        if (AppleStuff.keyPressed()) {
                            AppleStuff.text();
                            System.exit(0);
                        }
                    }
                }
            }
        }
    }
}
Rod's Color Pattern in Pascal

Faster: Here's the same program in Pascal (Kyan). It uses the lo-res library described above.
program Rod;
label 99;
var i, j, k, w: integer;
    fmi, fmk: integer;
    c: char;
#i lores.i
begin
  Gr;
  Writeln;
  Writeln('Press any key to exit');
  repeat
    for w := 3 to 50 do begin
      for i := 1 to 19 do begin
        for j := 0 to 19 do begin
          k := i + j;
          Color(j * 3 div (i + 3) + i * w div 12);
          fmi := 40 - i;  fmk := 40 - k;
          Plot(i, k);     Plot(k, i);
          Plot(fmi, fmk); Plot(fmk, fmi);
          Plot(k, fmi);   Plot(fmi, k);
          Plot(i, fmk);   Plot(fmk, i);
          if KeyPress(c) then goto 99
        end
      end
    end;
  until false;
99:  Tx;
end.
Rod's Color Pattern in C

Faster: Here's the same program in C. It uses the lo-res variation of the tgi library included in cc65. In this example, the library is linked statically. The use of unsigned 8-bit arithmetic offers a subtle advantage over the corresponding Pascal. Bill Buckel's has written an optimized cc65 version as well as an AztecC version.
#include <stdlib.h>
#include <conio.h>
#include <tgi.h>

extern char a2e_lo_install; // lo-res driver entry

unsigned char i, j, k, w, fmi, fmk;
unsigned int color;

int main(void) {
    tgi_install(&a2e_lo_install);
    tgi_init();

    while (1) {
        for (w = 3; w <= 50; ++w) {
            for (i = 1; i <= 19; ++i) {
                for (j = 0; j <= 19; ++j) {
                    k = i + j;
                    color = (j * 3) / (i + 3) + i * w / 12;
                    tgi_setcolor(color & 0x0f);
                    fmi = 40 - i;  fmk = 40 - k;
                    tgi_setpixel(i, k);     tgi_setpixel(k, i);
                    tgi_setpixel(fmi, fmk); tgi_setpixel(fmk, fmi);
                    tgi_setpixel(k, fmi);   tgi_setpixel(fmi, k);
                    tgi_setpixel(i, fmk);   tgi_setpixel(fmk, i);
                    if (kbhit() > 0) {
                        cgetc();
                        tgi_clear();
                        tgi_uninstall();
                        return EXIT_SUCCESS;
                    }
                }
            }
        }
    }
}
Rod's Color Pattern in Assembler

Fastest: here's the corresponding assembly language version I wrote for the Apple-Dayton Journal in March, 1982. It was re-published in Apple-Orchard in early 1983. Note that the plot routine (line 119) is optimized to use a lookup table rather than the monitor's 'gbascalc' code. Neil Parker describes several other optimizations to the original code; his page includes a delightful applet that recreates the original program.
0000:                1           LST   ON,Gen
0000:                2 * ROD's Color Pattern by J. Matthews
----- NEXT OBJECT FILE NAME IS ROD.0                            
2000:        2000    3           org   $2000
2000:        0028    4 forty     equ   $28
2000:        0026    5 gbasl     equ   $26
2000:        0030    6 color     equ   $30
2000:        003A    7 textpt    equ   $3A
2000:        003C    8 A1        equ   $3C
2000:        003E    9 A2        equ   $3E
2000:        0040   10 A3        equ   $40
2000:        0042   11 A4        equ   $42
2000:        0044   12 A5        equ   $44
2000:        00E0   13 w         equ   $E0
2000:        00E1   14 i         equ   $E1
2000:        00E2   15 j         equ   $E2
2000:        00E3   16 k         equ   $E3
2000:        00E4   17 fmi       equ   $E4
2000:        00E5   18 fmk       equ   $E5
2000:        C000   19 key       equ   $C000
2000:        C010   20 strobe    equ   $C010
2000:        FB1E   21 pread     equ   $FB1E
2000:        FB39   22 settx     equ   $FB39
2000:        FB40   23 setgr     equ   $FB40
2000:        FB5B   24 vtab      equ   $FB5B
2000:        FC58   25 clear     equ   $FC58
2000:        FCA8   26 wait      equ   $FCA8
2000:        FDF0   27 cout1     equ   $FDF0
2000:               28 *
2000:               29 * Set lo-res, mixed graphics & text, page 1
2000:               30 *
2000:20 40 FB       31           jsr   setgr
2003:20 58 FC       32           jsr   clear
2006:A9 16          33           lda   #$16
2008:20 5B FB       34           jsr   vtab
200B:20 29 21       35           jsr   prtext
200E:20 20 20 50    36           asc   "   PDL(0) controls speed of display"
2012:44 4C 28 30 
2016:29 20 63 6F 
201A:6E 74 72 6F 
201E:6C 73 20 73 
2022:70 65 65 64 
2026:20 6F 66 20 
202A:64 69 73 70 
202E:6C 61 79    
2031:8D             37           dfb   $8D
2032:20 20 20 20    38           asc   "      Press any key to exit."
2036:20 20 20 20 
203A:50 72 65 73 
203E:73 20 61 6E 
2042:79 20 6B 65 
2046:79 20 74 6F 
204A:20 65 78 69 
204E:74 2E       
2050:00             39           dfb   $00
2051:A9 03          40 start     lda   #$03          ;init loop counters
2053:85 E0          41           sta   w 
2055:A9 01          42 nxtw      lda   #$01
2057:85 E1          43           sta   i
2059:A9 00          44 nxti      lda   #$00
205B:85 E2          45           sta   j
205D:18             46 nxtj      clc
205E:A5 E1          47           lda   i
2060:65 E2          48           adc   j
2062:85 E3          49           sta   k
2064:20 4A 21       50           jsr   colsel
2067:A4 E1          51           ldy   i             ;plot i,k
2069:A5 E3          52           lda   k
206B:20 E9 20       53           jsr   plot
206E:A4 E3          54           ldy   k             ;plot k,i
2070:A5 E1          55           lda   i
2072:20 E9 20       56           jsr   plot
2075:38             57           sec                 ;plot 40-i, 40-k
2076:A9 28          58           lda   #forty
2078:E5 E1          59           sbc   i
207A:85 E4          60           sta   fmi
207C:A8             61           tay
207D:38             62           sec
207E:A9 28          63           lda   #forty
2080:E5 E3          64           sbc   k
2082:85 E5          65           sta   fmk
2084:20 E9 20       66           jsr   plot
2087:A4 E5          67           ldy   fmk           ;plot 40-k, 40-i
2089:A5 E4          68           lda   fmi
208B:20 E9 20       69           jsr   plot
208E:A4 E3          70           ldy   k             ;plot k, 40-i
2090:A5 E4          71           lda   fmi
2092:20 E9 20       72           jsr   plot
2095:A4 E4          73           ldy   fmi           ;plot 40-i, k
2097:A5 E3          74           lda   k
2099:20 E9 20       75           jsr   plot
209C:A4 E1          76           ldy   i             ;plot i, 40-k
209E:A5 E5          77           lda   fmk
20A0:20 E9 20       78           jsr   plot
20A3:A4 E5          79           ldy   fmk           ;plot 40-k, i
20A5:A5 E1          80           lda   i
20A7:20 E9 20       81           jsr   plot
20AA:20 C8 20       82           jsr   delay
20AD:E6 E2          83           inc   j             ;close loops
20AF:A5 E2          84           lda   j
20B1:C9 14          85           cmp   #$14
20B3:90 A8   205D   86           blt   nxtj
20B5:E6 E1          87           inc   i
20B7:A5 E1          88           lda   i
20B9:C9 14          89           cmp   #$14
20BB:90 9C   2059   90           blt   nxti
20BD:E6 E0          91           inc   w
20BF:A5 E0          92           lda   w
20C1:C9 33          93           cmp   #$33
20C3:90 90   2055   94           blt   nxtw
20C5:4C 51 20       95           jmp   start
20C8:               96 *
20C8:               97 * Delay by setting of PDL(0)
20C8:               98 *
20C8:A2 00          99 delay     ldx   #$00
20CA:20 1E FB      100           jsr   pread         ;read pdl(o)
20CD:98            101           tya 
20CE:4A            102           lsr                 ;divide by 4
20CF:4A            103           lsr
20D0:F0 03   20D5  104           beq   del1
20D2:20 A8 FC      105           jsr   wait
20D5:2C 00 C0      106 del1      bit   key           ;key pressed
20D8:30 01   20DB  107           bmi   exit
20DA:60            108           rts
20DB:68            109 exit      pla                  ;pop stack
20DC:68            110           pla
20DD:2C 10 C0      111           bit   strobe        ;clear strobe
20E0:20 39 FB      112           jsr   settx
20E3:20 58 FC      113           jsr   clear
20E6:4C D0 03      114           jmp   $3D0          ;exit via ProDOS
20E9:              115 *
20E9:              116 * Plot via table lookup
20E9:              117 * A = y coordinate; Y = x coordinate
20E9:              118 *
20E9:4A            119 plot      lsr
20EA:08            120           php
20EB:AA            121           tax
20EC:BD F9 20      122           lda   basl,x
20EF:85 26         123           sta   gbasl
20F1:BD 11 21      124           lda   bash,x
20F4:85 27         125           sta   gbasl+1
20F6:4C 05 F8      126           jmp   $F805
20F9:00 80 00 80   127 basl      dfb   $00,$80,$00,$80,$00,$80,$00,$80
20FD:00 80 00 80 
2101:28 A8 28 A8   128           dfb   $28,$A8,$28,$A8,$28,$A8,$28,$A8
2105:28 A8 28 A8 
2109:50 D0 50 D0   129           dfb   $50,$D0,$50,$D0,$50,$D0,$50,$D0
210D:50 D0 50 D0 
2111:04 04 05 05   130 bash      dfb   $04,$04,$05,$05,$06,$06,$07,$07
2115:06 06 07 07 
2119:04 04 05 05   131           dfb   $04,$04,$05,$05,$06,$06,$07,$07
211D:06 06 07 07 
2121:04 04 05 05   132           dfb   $04,$04,$05,$05,$06,$06,$07,$07
2125:06 06 07 07 
2129:              133 *
2129:              134 * Print text up to next null
2129:              135 *
2129:68            136 prtext    pla
212A:85 3A         137           sta   textpt
212C:68            138           pla
212D:85 3B         139           sta   textpt+1
212F:A0 00         140           ldy   #$00
2131:E6 3A         141 prt1      inc   textpt
2133:D0 02   2137  142           bne   prt2
2135:E6 3B         143           inc   textpt+1
2137:B1 3A         144 prt2      lda   (textpt),y
2139:F0 08   2143  145           beq   prt3
213B:09 80         146           ora   #$80
213D:20 F0 FD      147           jsr   cout1
2140:4C 31 21      148           jmp   prt1
2143:A5 3B         149 prt3      lda   textpt+1
2145:48            150           pha
2146:A5 3A         151           lda   textpt
2148:48            152           pha
2149:60            153           rts
214A:              154 *
214A:              155 * Color = j*3/(i+3)+i*w/12 
214A:              156 *
214A:18            157 colsel    clc                 ;A5 = j*3
214B:A5 E2         158           lda   j
214D:65 E2         159           adc   j
214F:65 E2         160           adc   j
2151:85 44         161           sta   A5
2153:A5 E1         162           lda   i             ;A4 = i+3
2155:69 03         163           adc   #$03
2157:85 42         164           sta   A4
2159:A0 FF         165           ldy   #$FF          ;A5 = A5/A4
215B:38            166           sec
215C:A5 44         167           lda   A5
215E:E5 42         168 divi3     sbc   A4
2160:C8            169           iny
2161:B0 FB   215E  170           bcs   divi3
2163:84 44         171           sty   A5
2165:A5 E1         172           lda   i             ;A1 = i
2167:85 3C         173           sta   A1
2169:A5 E0         174           lda   w             ;A2 = w
216B:85 3E         175           sta   A2
216D:A9 00         176           lda   #$00          ;A3 = A1*A2
216F:85 41         177           sta   A3+1
2171:A2 08         178           ldx   #$08
2173:0A            179 shift     asl
2174:26 41         180           rol   A3+1
2176:06 3E         181           asl   A2
2178:90 07   2181  182           bcc   bitcnt
217A:18            183           clc
217B:65 3C         184           adc   A1
217D:90 02   2181  185           bcc   bitcnt
217F:E6 41         186           inc   A3+1
2181:CA            187 bitcnt    dex
2182:D0 EF   2173  188           bne   shift
2184:85 40         189           sta   A3
2186:A9 0C         190           lda   #$0C          ;A2 = 12
2188:85 3E         191           sta   A2
218A:A2 08         192           ldx   #$08
218C:A5 40         193           lda   A3            ; A1 = A3
218E:85 3C         194           sta   A1
2190:A5 41         195           lda   A3+1          ;A1 = A1/A2
2192:06 3C         196 div       asl   A1
2194:2A            197           rol   A
2195:C5 3E         198           cmp   A2
2197:90 04   219D  199           bcc   bcnt
2199:E5 3E         200           sbc   A2
219B:E6 3C         201           inc   A1
219D:CA            202 bcnt      dex
219E:D0 F2   2192  203           bne   div
21A0:18            204           clc                  ;A = A1+A5
21A1:A5 3C         205           lda   A1
21A3:65 44         206           adc   A5
21A5:29 0F         207           and   #$0F          ;copy to upper nibble
21A7:85 30         208           sta   color
21A9:0A            209           asl
21AA:0A            210           asl
21AB:0A            211           asl
21AC:0A            212           asl
21AD:05 30         213           ora   color
21AF:85 30         214           sta   color
21B1:60            215           rts 
Copyright 1984, 2003 John B. Matthews
Distribution permitted under the terms of the GNU Public License.
Last updated 1-Nov-2009
Return home.