ttl     Random star field.
         bin
         incl    fmacs:specs.asm
         rorg    0
fsbase   set     $E00000
fspwrten set     fsbase+$20000     bits 0-3 of byte
fscolour set     fsbase+$20001     bits 0-3 of byte
fsorigin set     fsbase+$20002     X bits 0-5, Y bits 6-15
fscolmap set     fsbase+$30000     Colour map

black    set     $0
red      set     $1
green    set     $2
yellow   set     $3
blue     set     $4
magenta  set     $5
cyan     set     $6
white    set     $7

movel30  macro
\*       move.l  \1,(\2)+   1
         move.l  \1,(\2)+   2
         move.l  \1,(\2)+   3
         move.l  \1,(\2)+   4
         move.l  \1,(\2)+   5
         move.l  \1,(\2)+   6
         move.l  \1,(\2)+   7
         move.l  \1,(\2)+   8
         move.l  \1,(\2)+   9
         move.l  \1,(\2)+   10
         move.l  \1,(\2)+   11
         move.l  \1,(\2)+   12
         move.l  \1,(\2)+   13
         move.l  \1,(\2)+   14
         move.l  \1,(\2)+   15
         move.l  \1,(\2)+   16
         move.l  \1,(\2)+   17
         move.l  \1,(\2)+   18
         move.l  \1,(\2)+   19
         move.l  \1,(\2)+   20
         move.l  \1,(\2)+   21
         move.l  \1,(\2)+   22
         move.l  \1,(\2)+   23
         move.l  \1,(\2)+   24
         move.l  \1,(\2)+   25
         move.l  \1,(\2)+   26
         move.l  \1,(\2)+   27
         move.l  \1,(\2)+   28
         move.l  \1,(\2)+   29
         move.l  \1,(\2)+   30
         endm

         dc.w    $FE00
clear3   movem.l d0-d1/a0,-(sp)
         move.w  #$FF00,fspwrten
         move.w  #$03FF,d1
         move.l  #-1,d0
         lea     fsbase,a0
fsclrlp3 movel30 d0,a0
         move.l  d0,(a0)+
         move.l  d0,(a0)+
         dbra    d1,fsclrlp3
         movem.l (sp)+,d0-d1/a0
         rts

plot3    movem.l d0-d1/a0,-(sp)
         lea     fsbase,a0
         and.l   #$03FF,d1
         lsl.l   #7,d1
         add.l   d1,a0
         move.w  d0,d1
         lsr.w   #3,d1
         and.w   #$007F,d1
         and.w   #$0007,d0
         move.b  bitab(d0.w),0(a0,d1.w)
         movem.l (sp)+,d0-d1/a0
         rts
bitab    dc.b    %10000000,%01000000
         dc.b    %00100000,%00010000
         dc.b    %00001000,%00000100
         dc.b    %00000010,%00000001
         ds.w    0

string   macro
\*       dc.b    \@-*-1,\1
\@       equ     *
         endm

*dreml    macro
*\*       move.l  d2,d0
*         clr.w   d0
*         swap    d0
*         divu    #688,d0
*         move.w  d2,d0
*         divu    #688,d0
*         move.l  #0,d1
*         move.w  d0,d1
*         swap    d0
*         divu    #512,d1
*         swap    d1
*         endm
dreml    macro
\*       move.l  d2,d1
         and.w   #511,d1
         move.l  d2,d0
         lsr.l   #5,d0
         lsr.l   #4,d0
         divu    #688,d0
         swap    d0
         endm

start    move.l  #0,d0
         move.l  #fscolmap+2,a0
         move.w  #255,d1
icolmapl move.w  d0,(a0)
         lea     4(a0),a0
         dbra    d1,icolmapl
         bsr     clear3
         move.l  #$FF000000+511<<6,fspwrten
         lea     noprompt,a0
         jsr     prompt
readloop jsr     read
         tst.l   d0
         ble     readloop
         cmp.l   #65535,d0
         bgt     readloop
         move.l  d0,d4
         lsl.l   #2,d0
         move.l  sp,a1
         sub.l   d0,a1
         cmp.l   d6,a1
         bcc.s   ok
         lea     toobig,a0
         jmp     printstring
ok       lea     -4(a1),a1
         move.w  d4,d5
         sub.w   #1,d5
         jsr     cputime
         or.w    #1,d0
         move.l  d0,0(a1)
         move.l  d0,d2
         move.l  d0,d3
iloop    move.l  (a1),d0
         divu    #7,d0
         swap    d0
         add.w   #1,d0
         move.b  d0,fscolour
         lsr.w   2(a1)
         bcc     noceor
         eor.w   #$8031,2(a1)
noceor   dreml
         bsr     plot3
         move.w  d0,(a1)+
         move.w  d1,(a1)+
         lsr.l   d2
         bcc.s   noeor0
         eor.l   #$80030001,d2
noeor0   dbra    d5,iloop
         move.w  #$0000,fscolmap+2
         move.w  #$001F,fscolmap+6
         move.w  #$03E0,fscolmap+10
         move.w  #$03FF,fscolmap+14
         move.w  #$7C00,fscolmap+18
         move.w  #$7C1F,fscolmap+22
         move.w  #$7FE0,fscolmap+26
         move.w  #$7FFF,fscolmap+30
         move.w  #$7FFF,fscolmap+34
         move.w  #$7FE0,fscolmap+38
         move.w  #$7C1F,fscolmap+42
         move.w  #$7C00,fscolmap+46
         move.w  #$03FF,fscolmap+50
         move.w  #$03E0,fscolmap+54
         move.w  #$001F,fscolmap+58
         move.w  #$0000,fscolmap+62
loop     move.b  #black,fscolour
         move.l  d3,d5
         clr.w   d5
         swap    d5
         divu    d4,d5
         move.w  d3,d5
         divu    d4,d5
         clr.w   d5
         swap    d5
         lsl.l   #2,d5
         move.w  4(a1,d5.l),d0
         move.w  6(a1,d5.l),d1
         bsr     plot3
         move.l  (a1),d0
         divu    #7,d0
         swap    d0
         add.w   #1,d0
         move.b  d0,fscolour
         dreml
         bsr     plot3
         move.w  d0,4(a1,d5.l)
         move.w  d1,6(a1,d5.l)
         lsr.l   d2
         bcc.s   noeor1
         eor.l   #$80030001,d2
noeor1   lsr.l   d3
         bcc.s   noeor2
         eor.l   #$80030001,d3
noeor2   lsr.w   2(a1)
         bcc     loop
         eor.w   #$8031,2(a1)
         bra     loop
noprompt string  <'number of points (65535 max) :'>
toobig   string  <'not enough memory!',10>
         ds.w    0
         bra.w   start
         end