asm
  di
  end asm

asm
  ld a,1            ;modes 1 to 4 should be 0-3 <-??????????
  dec a
  rrca              ;rotate them round to
  rrca              ;bits 7,6 and 5.
  rrca
  ld b,a            ;and save in b.
  in a,($fc)        ;get current screen page.
  and $1f           ;strip off the mode bits
  or b              ;and replace with new mode.
  out ($fc),a       ;set new screen mode.
  in  a,($fb)       ; page at &8000, page+1 at &c000
  inc a             ; put screen at HMPR page+1
  and %00011111     ; keep only page bits
  or  0*32          ; merge in mode 1 bits ((mode-1)*32? not working?) <-!!!!!!
  out ($fc),a       ; set video mode+page to look at &c000
  end asm

asm
  ld a,7
  out ($FE),a
  ld a,6
  out ($FE),a
  ld a,5
  out ($FE),a
  end asm

'-------------------------------------------------------------------------------

#include "library/samcoupernd.bas"
#include "library/samcoupepaletteout.bas"
#include "library/samcoupedelay.bas"
#include "library/samcoupehexcolour.bas"
#include "library/samcoupeborder.bas"
#include "library/arcadetypeface.bas"

sub samcoupeputcharmode2(txpos as uinteger,typos as uinteger, tchar as uinteger,tattr as ubyte,ttdp as uinteger):
  dim tln as uinteger at $4000
  dim tdq as uinteger at $4002
  tdq=(txpos)+((typos band 7)*32)+((int(typos/8))*2048)  ' +(i3*256)
  for tln=0 to 7
    poke $C000+tdq+(tln*256),peek(ttdp+((tchar band $FF)*8)+tln)
    next
  poke $D800+(txpos)+(typos*32),tattr
  end sub

'-------------------------------------------------------------------------------


'sub samcoupeattr(ikv as ubyte,pav as ubyte):
'  '- usage: ink priority (from 0 to 15), and only using 3 bits lsb from paper
'  ink(ikv band 7):paper(pav band 7)
'  bright((ikv band 16)/16)
'  end sub

'-------------------------------------------------------------------------------

asm
  ld bc,$04F8
  ld a,$3F
  out (c),a
  end asm

dim i as uinteger at $4010
dim seed as uinteger at $4012
dim i0 as uinteger at $4014
dim i1 as uinteger at $4016
dim i2 as uinteger at $4018
dim i3 as uinteger at $401A
dim i4 as uinteger at $401C
dim i5 as uinteger at $401E
dim eee as uinteger at $4020
dim sq1 as uinteger at $4022
dim sq2 as uinteger at $4024
dim sq3 as uinteger at $4026
dim sq4 as uinteger at $4028
dim ex0 as uinteger at $402A
dim ey0 as uinteger at $402C

samcoupeborder(4)

for i=0 to 15
  samcoupepaletteout(i,samcoupehexcolour(peek(uinteger,(32*0)+@palette01+(i*2))))
  next

seed=0

for i5=0 to 23
  for i4=0 to 31
    samcoupeputcharmode2(i4,i5,code("."),64+(3*8)+5,@typeface01-256)
    next:next

for i5=0 to 15
  for i4=0 to 15
    samcoupeputcharmode2(i4+15,i5+7,i4+(i5*16),64+(0*8)+6,@typeface01-256)
    next:next

for i5=0 to 7
  samcoupeputcharmode2(i5+1,1,code("."),0+(i5*8)+0,@typeface01-256)
  samcoupeputcharmode2(i5+1,2,code("."),64+(i5*8)+0,@typeface01-256)
  next

eee=0:ex0=4:ey0=4
do
  seed=samcoupernd(seed)
  sq1=((255-(in 64510)) band 2)/2 bor ((255-(in 65022)) band 2) bor ((255-(in 65022)) band 1)*4 bor ((255-(in 65022)) band 4)*2 :'- wsad
  sq2=((255-(in 64510)) band 16)/16 bor ((255-(in 65022)) band 16)/8 bor ((255-(in 65022)) band 8)/2 bor ((255-(in 49150)) band 16)/2 :'- tgfh
  sq3=((255-(in 57342)) band 4)/4 bor ((255-(in 49150)) band 4)/2 bor ((255-(in 49150)) band 8)/2 bor ((255-(in 49150)) band 2)*4 :'- ikjl
  sq4=((255-(in 61438)) band 8)/8 bor ((255-(in 61438)) band 16)/8 bor ((255-(in 63486)) band 16)/4 bor ((255-(in 61438)) band 4)*2 :'-7658

  samcoupeputcharmode2(5,22,48+(eee mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(4,22,48+((int(eee/10)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(3,22,48+((int(eee/100)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(2,22,48+((int(eee/1000)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(1,22,48+((int(eee/10000)) mod 10),0+(0*8)+7,@typeface01-256)

  samcoupeputcharmode2(5,17,48+(sq1 mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(4,17,48+((int(sq1/10)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(3,17,48+((int(sq1/100)) mod 10),0+(0*8)+7,@typeface01-256)

  samcoupeputcharmode2(5,18,48+(sq2 mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(4,18,48+((int(sq2/10)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(3,18,48+((int(sq2/100)) mod 10),0+(0*8)+7,@typeface01-256)

  samcoupeputcharmode2(5,19,48+(sq3 mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(4,19,48+((int(sq3/10)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(3,19,48+((int(sq3/100)) mod 10),0+(0*8)+7,@typeface01-256)

  samcoupeputcharmode2(5,20,48+(sq4 mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(4,20,48+((int(sq4/10)) mod 10),0+(0*8)+7,@typeface01-256)
  samcoupeputcharmode2(3,20,48+((int(sq4/100)) mod 10),0+(0*8)+7,@typeface01-256)

  ex0=ex0-((sq1 band 4)/4)+((sq1 band 8)/8)
  ey0=ey0-((sq1 band 1)/1)+((sq1 band 2)/2)

  samcoupeputcharmode2(ex0 band 31,ey0 mod 24,eee band $FF,seed,@typeface01-256)

  eee=eee+1
  loop

do:loop

'-------------------------------------------------------------------------------

do
  for i5=0 to 23
    for i4=0 to 31
      seed=samcoupernd(seed):i3=seed:seed=samcoupernd(seed)
      samcoupeputcharmode2(i4,i5,seed,i3,@typeface01)
      next:next
  loop



do:loop





seed=43

loop01:
for i0=0 to 2
  for i1=0 to 7
    for i2=0 to 31
      seed=samcoupernd(seed):i5=seed
      for i3=0 to 7
        i=(i2)+(i1*32)+(i3*256)+(i0*2048)
        seed=samcoupernd(seed)
        poke $C000+i,peek(@typeface01+((i5 band $FF)*8)+i3)
        next
      i=(i2)+(i1*32)+(i0*256)
      seed=samcoupernd(seed)
      poke $D800+i,seed mod 128
      samcoupedelay(2000)
      next:next:next

samcoupeborder(0)

for i=0 to 15
  samcoupepaletteout(i,samcoupehexcolour(peek(uinteger,(32*7)+@palette01+(i*2))))
  next

samcoupeborder(7)


goto loop01

'-------------------------------------------------------------------------------


palette01:
asm
  ;-god-atarist
  defw $000,$005,$500,$055
  defw $555,$55A,$A50,$A55
  defw $5AF,$AA5,$AAA,$AAF
  defw $FAA,$FF0,$AFF,$FFF
  ;-goemonkonamimsx
  defw $000,$FB9,$000,$F00
  defw $FB9,$B60,$FFF,$620
  defw $FB0,$B64,$940,$049
  defw $999,$092,$FFF,$042
  ;-sg1000mk3
  defw $000,$000,$0A0,$0F0
  defw $005,$00F,$500,$0FF
  defw $A00,$F00,$550,$FF0
  defw $050,$F0F,$555,$FFF
  ;-mojontwinsulaplus
  defw $000,$40F,$B20,$94A
  defw $460,$26F,$B90,$BBF
  defw $000,$04F,$D40,$B6A
  defw $6D0,$0BF,$DB5,$FFF
  ;-sgi4dwm
  defw $000,$F00,$0F0,$FF0
  defw $00F,$F0F,$0FF,$FFF
  defw $555,$C88,$8C8,$884
  defw $88C,$848,$488,$AAA
  ;-apple2c16
  defw $000,$724,$437,$E3F
  defw $054,$888,$19F,$BBF
  defw $440,$E60,$888,$FAB
  defw $1C0,$BC8,$8DB,$FFF
  ;-msx1
  defw $000,$000,$2D2,$6F6
  defw $22F,$36F,$B22,$4DF
  defw $F22,$F66,$DD2,$DD9
  defw $292,$D4B,$BBB,$FFF
  ;-c64
  defw $000,$FFF,$A00,$AFF
  defw $A5A,$0A5,$00A,$FF5
  defw $FA5,$550,$F55,$555
  defw $555,$AF5,$0AF,$AAA
  end asm


'- .sbt file: old versions of Simcoupe needs:
'- boot1:load1:call32768

