SPEED TEST OF MOVE MEMORY & ERASE SCREEN WAYS

Initialisation and utils for GFA demo and games on ATARI ST

' SPEED TEST OF MOVE MEMORY & ERASE SCREEN WAYS
' 1.9 062011 HYLST
' 100 LOOP   with TIMER 1/200 e sec
RESERVE 200000
OUT 4,18
sup%=GEMDOS(32,L:0)
OPEN "o",#1,"testblit.txt"
PRINT #1;"SPEED TEST OF MOVE MEMORY & ERASE SCREEN WAYS WITHOUT THEN WITH BLITTER"
PRINT #1;"TIME FOR 100 (OR 1000, SPECIFIED) LOOPS EXPRESSED IN 1/200 SECONDS"
PRINT #1;"IN ST LOW ON ATARI STE - FS = WHOLE SCREEN  1/2 = ONLY 100 FIRST LINES (16000)  X NOLOOP LOOP ITERATION AVOIDED LIST OF CARD ... FOR 1 LINE (160O)"
CLS
SGET a$
a%=V:a$
xb%=XBIOS(2)
t%=TIMER
FOR t&=0 TO 99
NEXT t&
t%=TIMER-t%
PRINT #1;"NOTHING BUT THE LOOP, sub and timer access ";t%
VSYNC
t%=TIMER
FOR t&=0 TO 99
  VSYNC
NEXT t&
t%=TIMER-t%
PRINT #1;"VSYNC :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 999
  PLOT 12,13
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS PLOT 12,13 :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 999
  PSET 12,13,15
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS PSET 12,13,15 :";t%
' ~INP(2)
x&=12
y&=13
adrx&=AND(SHR(x&,1),65528)
adry&=MUL(160,y&) ! could preprecalc x160 if realtime sure...
adre%=ADD(xb%,ADD(adrx&,adry&))
dec%=SHR(32768,(x& AND &HF))
t%=TIMER
FOR t&=0 TO 999
  CARD{adre%}=CARD{adre%} OR dec%
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS PSET WITH CARD ADRE DECA PRECA 12,13  :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 999
  a&=POINT(12,13)
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS a&=POINT(12,13)  :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 999
  a&=PTST(12,13)
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS a&=PTST(12,13)  :";t%
' ~INP(2)
xbe%=xb%+32000-8
t%=TIMER
FOR t&=0 TO 99
  FOR e%=xb% TO xbe% STEP 160
    LONG{e%}=0
    LONG{e%+4}=0
    LONG{e%+8}=0
    LONG{e%+12}=0
    LONG{e%+16}=0
    LONG{e%+20}=0
    LONG{e%+24}=0
    LONG{e%+28}=0
    LONG{e%+32}=0
    LONG{e%+36}=0
    LONG{e%+40}=0
    LONG{e%+44}=0
    LONG{e%+48}=0
    LONG{e%+52}=0
    LONG{e%+56}=0
    LONG{e%+60}=0
    LONG{e%+64}=0
    LONG{e%+68}=0
    LONG{e%+72}=0
    LONG{e%+76}=0
    LONG{e%+80}=0
    LONG{e%+84}=0
    LONG{e%+88}=0
    LONG{e%+92}=0
    LONG{e%+96}=0
    LONG{e%+100}=0
    LONG{e%+104}=0
    LONG{e%+108}=0
    LONG{e%+112}=0
    LONG{e%+116}=0
    LONG{e%+120}=0
    LONG{e%+124}=0
    LONG{e%+128}=0
    LONG{e%+132}=0
    LONG{e%+136}=0
    LONG{e%+140}=0
    LONG{e%+144}=0
    LONG{e%+148}=0
    LONG{e%+152}=0
    LONG{e%+156}=0
  NEXT e%
NEXT t&
t%=TIMER-t%
PRINT #1;"FS LONG 4PL X NOLOOP :";t%
' ~INP(2)
fs%=xb%+32000-4
t%=TIMER
FOR t&=0 TO 99
  FOR e%=xb% TO xbe% STEP 160
    CARD{e%}=0
    CARD{e%+8}=0
    CARD{e%+16}=0
    CARD{e%+24}=0
    CARD{e%+32}=0
    CARD{e%+40}=0
    CARD{e%+48}=0
    CARD{e%+56}=0
    CARD{e%+64}=0
    CARD{e%+72}=0
    CARD{e%+80}=0
    CARD{e%+88}=0
    CARD{e%+96}=0
    CARD{e%+104}=0
    CARD{e%+112}=0
    CARD{e%+120}=0
    CARD{e%+128}=0
    CARD{e%+136}=0
    CARD{e%+144}=0
    CARD{e%+152}=0
  NEXT e%
NEXT t&
PRINT #1;"FS CARD=0 1 plan X NOLOOP :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  FOR e%=xb% TO fs% STEP 160
    CARD{e%}=CARD{e%}
    CARD{e%+8}=CARD{e%+8}
    CARD{e%+16}=CARD{e%+16}
    CARD{e%+24}=CARD{e%+24}
    CARD{e%+32}=CARD{e%+32}
    CARD{e%+40}=CARD{e%+40}
    CARD{e%+48}=CARD{e%+48}
    CARD{e%+56}=CARD{e%+56}
    CARD{e%+64}=CARD{e%+64}
    CARD{e%+72}=CARD{e%+72}
    CARD{e%+72}=CARD{e%+72}
    CARD{e%+88}=CARD{e%+88}
    CARD{e%+96}=CARD{e%+96}
    CARD{e%+104}=CARD{e%+104}
    CARD{e%+112}=CARD{e%+112}
    CARD{e%+120}=CARD{e%+120}
    CARD{e%+128}=CARD{e%+128}
    CARD{e%+136}=CARD{e%+136}
    CARD{e%+144}=CARD{e%+144}
    CARD{e%+152}=CARD{e%+152}
  NEXT e%
NEXT t&
PRINT #1;"FS CARD=CARD FOR COPY 1 PLANE X NOLOOP :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  BMOVE a%,xb%,32000
NEXT t&
t%=TIMER-t%
PRINT #1;"BMOVE :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 999
  ALINE 0,0,319,199,1,65535,0
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS ALINE 0 0 319 199  :";t%
' ~INP(2)
pattern=65535
adr%=V:pattern
t%=TIMER
FOR t&=0 TO 999
  HLINE 0,99,319,12,0,adr%,0
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS HLINE 0 319 99 : ";t%
' ~INP(2)
COLOR 0
t%=TIMER
FOR t&=0 TO 999
  LINE 0,0,319,199
NEXT t&
t%=TIMER-t%
PRINT #1;"1000 LOOPS LINE 0 0 319 199  :";t%
' ~INP(2)
' here starts function that blitter speed up
blitter!=TRUE
PRINT #1;"BLITTER ON"
blitter:
blitter(blitter!)
t%=TIMER
FOR t&=0 TO 99
  CLS
NEXT t&
t%=TIMER-t%
PRINT #1;"CLS :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  SPUT a$
NEXT t&
t%=TIMER-t%
PRINT #1;"SPUT :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  RC_COPY a%,0,0,320,200 TO xb%,0,0
NEXT t&
t%=TIMER-t%
PRINT #1;"FS RCCOPY :";t%
' ~INP(2)
prepcopybitblt
GET 0,0,319,99,b$
t%=TIMER
FOR t&=0 TO 99
  PUT 1,100,b$
NEXT t&
t%=TIMER-t%
PRINT #1;"PUT 5,8  1/2 :";t%
t%=TIMER
FOR t&=0 TO 99
  PUT 0,0,b$
NEXT t&
t%=TIMER-t%
PRINT #1;"PUT 0,0  1/2 :";t%
t%=TIMER
FOR t&=0 TO 99
  RC_COPY xb%,0,0,320,100 TO xb%,160,0
NEXT t&
t%=TIMER-t%
PRINT #1;"RCCOPY MODE 0 1/2 :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  BITBLT struct%
NEXT t&
t%=TIMER-t%
PRINT #1;"LA BITBLT 1PL 1/2 :";t%
' ~INP(2)
CARD{struct%+4}=2  ! nbre de plans (monochrome : 1 ; 4 couleurs : 2 ; 16 couleurs : 4 ; 256 couleurs : 8)
CARD{struct%+22}=4 !Offset en octets entre deux mots du mme plan de couleur
CARD{struct%+36}=4 !Incrmenten octets entre deux mots du mme plan de couleur
t%=TIMER
FOR t&=0 TO 99
  BITBLT struct%
NEXT t&
' argh... struct% seems to be modified after one call... what's modified ?
t%=TIMER-t%
PRINT #1;"LA BITBLT 2PL 1/2 :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  BITBLT struct%
NEXT t&
t%=TIMER-t%
PRINT #1;"LA BITBLT 4PL 1/2 :";t%
' ~INP(2)
vdiblit
t%=TIMER
FOR t&=0 TO 99
  BITBLT vblit_surface_source%(),vblit_surface_dest%(),vblit_param%()
NEXT t&
t%=TIMER-t%
PRINT #1;"VDI BITBLT 4PL 1/2 :";t%
' ~INP(2)
vblit_surface_source%(5)=2
vblit_surface_dest%(5)=2
t%=TIMER
FOR t&=0 TO 99
  BITBLT vblit_surface_source%(),vblit_surface_dest%(),vblit_param%()
NEXT t&
t%=TIMER-t%
PRINT #1;"VDI BITBLT 2PL 1/2 :";t%
' ~INP(2)
vblit_surface_source%(5)=1
vblit_surface_dest%(5)=1
t%=TIMER
FOR t&=0 TO 99
  BITBLT vblit_surface_source%(),vblit_surface_dest%(),vblit_param%()
NEXT t&
t%=TIMER-t%
PRINT #1;"VDI BITBLT 1PL 1/2 :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  TEXT 5,20,"DOES BLITTER SPEED TEXT PRINT ?"
NEXT t&
t%=TIMER-t%
PRINT #1;"TEXT DEFAULT :";t%
' ~INP(2)
DEFFILL 15
t%=TIMER
FOR t&=0 TO 99
  PBOX 0,0,159,99
NEXT t&
t%=TIMER-t%
PRINT #1;"PBOX 0 0 159 99 :";t%
' ~INP(2)
t%=TIMER
FOR t&=0 TO 99
  ARECT 0,0,159,99,15,0,adr%,0
NEXT t&
t%=TIMER-t%
PRINT #1;"ARECT 0 0 159 99  :";t%
' ~INP(2)
DIM x&(3),y&(3)
x&(0)=0
y&(0)=0
x&(1)=79
y&(1)=99
x&(2)=159
y&(2)=10
t%=TIMER
FOR t&=0 TO 99
  POLYFILL 3,x&(),y&()
NEXT t&
t%=TIMER-t%
PRINT #1;"POLYFILL 0 0 79 99 159 10  :";t%
' ~INP(2)
m&=-1
m%=V:m&
DIM xyp&(6)
xyp&(0)=0
xyp&(1)=0
xyp&(2)=79
xyp&(3)=99
xyp&(4)=159
xyp&(5)=10
pnt%=V:xyp&(0)
t%=TIMER
FOR t&=0 TO 99
  APOLY pnt%,4,0 TO 199,1,0,m%,0
NEXT t&
t%=TIMER-t%
PRINT #1;"APOLY TO 0 0 79 99 159 10  : DOESN T WORK ?";t%
' ~INP(2)
IF blitter!
  PRINT #1;"END OF TEST"
  CLOSE #1
  VSYNC
  OPEN "o",#1,"testnobl.txt"
  PRINT #1;"BLITTER OFF"
  blitter!=FALSE
  GOTO blitter
ENDIF
PRINT #1;"END OF TEST"
CLOSE #1
' halftoned
~GEMDOS(32,L:sup%)
OUT 4,8
RESERVE
EDIT
> PROCEDURE halftoned
  ' ======== second blitting = halftoned ========
  DIM buff_halftone&(16)
  halftone%=V:buff_halftone&(0)
  ' setting up halftone
  CARD{halftone%+0}=&X0
  CARD{halftone%+2}=&X0
  CARD{halftone%+4}=&X1010101010101010
  CARD{halftone%+6}=&X0
  CARD{halftone%+8}=&X1010101010101010
  CARD{halftone%+10}=&X101010101010101
  CARD{halftone%+12}=&X1010101010101010
  CARD{halftone%+14}=&X1111111111111111
  CARD{halftone%+16}=&X1111111111111111
  CARD{halftone%+18}=&X1010101010101010
  CARD{halftone%+20}=&X101010101010101
  CARD{halftone%+22}=&X1010101010101010
  CARD{halftone%+24}=&X0
  CARD{halftone%+26}=&X1010101010101010
  CARD{halftone%+28}=&X0
  CARD{halftone%+30}=&X0
  '
  CARD{struct%+28}=60
  CARD{struct%+30}=5
  LONG{struct%+42}=halftone%
  CARD{struct%+46}=2
  CARD{struct%+48}=0
  CARD{struct%+50}=31
  BITBLT struct%
  CARD{struct%+28}=100
  CARD{struct%+30}=39
  BITBLT struct%
  ' ======== third blitting = halftoned with 4 bitplan pattern ========
  DIM buff_halftone4&(64)
  halftone4%=V:buff_halftone&(0)
  halftone%=halftone4%
  ' setting up halftone
  ' -- bitplan 0--
  halftone%=halftone4%
  CARD{halftone%+0}=&X0
  CARD{halftone%+8}=&X0
  CARD{halftone%+16}=&X1010101010101010
  CARD{halftone%+24}=&X0
  CARD{halftone%+32}=&X1010101010101010
  CARD{halftone%+40}=&X101010101010101
  CARD{halftone%+48}=&X1010101010101010
  CARD{halftone%+56}=&X1111111111111111
  CARD{halftone%+64}=&X1111111111111111
  CARD{halftone%+72}=&X1010101010101010
  CARD{halftone%+80}=&X101010101010101
  CARD{halftone%+88}=&X1010101010101010
  CARD{halftone%+96}=&X0
  CARD{halftone%+104}=&X1010101010101010
  CARD{halftone%+112}=&X0
  CARD{halftone%+120}=&X0
  ' -- bitplan 1--
  halftone%=halftone%+2
  CARD{halftone%+0}=&X0
  CARD{halftone%+8}=&X1010101010101010
  CARD{halftone%+16}=&X0
  CARD{halftone%+24}=&X1010101010101010
  CARD{halftone%+32}=&X101010101010101
  CARD{halftone%+40}=&X1010101010101010
  CARD{halftone%+48}=&X1111111111111111
  CARD{halftone%+56}=&X1111111111111111
  CARD{halftone%+64}=&X1111111111111111
  CARD{halftone%+72}=&X1010101010101010
  CARD{halftone%+80}=&X101010101010101
  CARD{halftone%+88}=&X1010101010101010
  CARD{halftone%+96}=&X0
  CARD{halftone%+104}=&X1010101010101010
  CARD{halftone%+112}=&X0
  CARD{halftone%+120}=&X0
  ' -- bitplan 2--
  halftone%=halftone%+2
  CARD{halftone%+0}=&X0
  CARD{halftone%+8}=&X1010101010101010
  CARD{halftone%+16}=&X0
  CARD{halftone%+24}=&X1010101010101010
  CARD{halftone%+32}=&X101010101010101
  CARD{halftone%+40}=&X1010101010101010
  CARD{halftone%+48}=&X1111111111111111
  CARD{halftone%+56}=&X1111111111111111
  CARD{halftone%+64}=&X1111111111111111
  CARD{halftone%+72}=&X1111111111111111
  CARD{halftone%+80}=&X1010101010101010
  CARD{halftone%+88}=&X101010101010101
  CARD{halftone%+96}=&X1010101010101010
  CARD{halftone%+104}=&X0
  CARD{halftone%+112}=&X1010101010101010
  CARD{halftone%+120}=&X0
  ' -- bitplan 3--
  halftone%=halftone%+2
  CARD{halftone%+0}=&X1010101010101010
  CARD{halftone%+8}=&X0
  CARD{halftone%+16}=&X1010101010101010
  CARD{halftone%+24}=&X101010101010101
  CARD{halftone%+32}=&X1010101010101010
  CARD{halftone%+40}=&X1111111111111111
  CARD{halftone%+48}=&X1111111111111111
  CARD{halftone%+56}=&X1111111111111111
  CARD{halftone%+64}=&X1111111111111111
  CARD{halftone%+72}=&X1111111111111111
  CARD{halftone%+80}=&X1010101010101010
  CARD{halftone%+88}=&X101010101010101
  CARD{halftone%+96}=&X1010101010101010
  CARD{halftone%+104}=&X0
  CARD{halftone%+112}=&X1010101010101010
  CARD{halftone%+120}=&X0
  ~INP(2)
  CARD{struct%+28}=210
  CARD{struct%+30}=9
  LONG{struct%+42}=halftone4%
  CARD{struct%+46}=8
  CARD{struct%+48}=2
  CARD{struct%+50}=127
  BITBLT struct%
  ~INP(2)
RETURN
> PROCEDURE prepcopybitblt
  PRINT "CECI EST UN MESSAGE DE TEST BIDON POUR TEST DE COPIE D'CRAND"
  COLOR 15
  LINE 0,0,319,99
  COLOR 1
  LINE 0,99,319,0
  CLS
  DEFFILL 1
  PCIRCLE 30,30,30
  DEFFILL 9
  PCIRCLE 60,30,30
  DEFFILL 4
  PCIRCLE 30,45,10
  DEFFILL 3
  PCIRCLE 45,45,10
  DEFFILL 2
  PCIRCLE 60,45,10
  ERASE linea_params&()
  DIM linea_params&(40)
  struct%=V:linea_params&(0)
  CARD{struct%}=160 ! larg pix bloc a copier
  CARD{struct%+2}=100 ! haut "
  CARD{struct%+4}=1  ! nbre de plans (monochrome : 1 ; 4 couleurs : 2 ; 16 couleurs : 4 ; 256 couleurs : 8)
  CARD{struct%+6}=1 ! coul 1er plan
  CARD{struct%+8}=0 ! coul fond
  LONG{struct%+10}=&H3030303 ! Tableau de 4 octets contenant le mode graphique  utiliser en fonction des bits de la couleur source et destination
  ' Pour chaque plan de couleur, index = (bit de la couleur de premier plan * 2) + (bit de la couleur de fond)
  CARD{struct%+14}=0 !Coordonnes x du coin en haut  gauche, dans la surface source, du bloc  copier
  CARD{struct%+16}=0 !Coordonnes y du coin en haut  gauche, dans la surface source, du bloc  copier
  LONG{struct%+18}=xb% ! Adresse de la surface source
  CARD{struct%+22}=2 !Offset en octets entre deux mots du mme plan de couleur
  ' En gnral, CARD{struct%+22} = 2 * Nombre de plan de couleur de la surface source
  CARD{struct%+24}=160 !Incrment en octets entre le dbut d'une ligne et la suivante
  ' Pour une zone mmoire continue, ce sera la largeur en pixel * le nombre de plan de couleur *
  CARD{struct%+26}=2 !Incrment en octets pour passer au plan suivant
  CARD{struct%+28}=0 !Coordonnes x du coin en haut  gauche, dans la surface cible, du bloc  copier
  CARD{struct%+30}=0 !Coordonnes y du coin en haut  gauche, dans la surface cible, du bloc  copier
  LONG{struct%+32}=xb%+16000 !Adresse de la surface cible
  CARD{struct%+36}=2 !Incrmenten octets entre deux mots du mme plan de couleur
  ' En gnral, CARD{struct%+36} = 2 * Nombre de plan de couleur de la surface cible
  CARD{struct%+38}=160 !INCREMENT EN OCTETS ENTRE LE DBUT D'UNE LIGNE ET LA SUIVANTE
  ' POUR UNE ZONE MMOIRE CONTINUE, CE SERA LA LARGEUR EN PIXEL * LE NOMBRE DE PLAN DE COULEUR *
  CARD{struct%+40}=2 !INCRMENT EN OCTETS POUR PASSER AU PLAN SUIVANT
  ' EN GNRAL, CE SERA 2
  LONG{struct%+42}=0 !ADRESSE DU MOTIF DE DEMI-TEINTE
  ' L'ADRESSE DOIT TRE NON NULLE POUR UTILISER CETTE FONCTIONNALIT
  CARD{struct%+46}=0 !TAILLE EN OCTETS D'UNE LIGNE DE MOTIF DE DEMI-TEINTE
  CARD{struct%+48}=2 !TAILLE EN OCTETS D'UN PLAN D'UNE LIGNE DE MOTIF
  ' SI LE MOTIF EST SUR UN SEUL PLAN, ON MET 0
  CARD{struct%+50}=0 !TAILLE DU MOTIF EN OCTETS - 1
  ' CETTE TAILLE DOIT TRE UNE PUISSANCE DE DEUX (2, 4, 8, 16, ...)
  ' ======== first blitting = normal ========
RETURN
> PROCEDURE vdiblit
  ' ================================
  ' VDI blitter test
  ' The top half of the screen will be the source,
  ' the bottom half will be the destination
  ' ======== init screen ========
  ' this will be used as source
  ' and target for bitblitting.
  '
  ' this test program use the low resolution
  '
  '  CLS
  DEFFILL 15
  PCIRCLE 30,30,30
  DEFFILL 2
  PCIRCLE 60,30,30
  '
  FOR i=1 TO 15
    DEFFILL i
    PBOX i*8+160,j*10+50,i*8+167,j*10+59
  NEXT i
  '
  RANDOMIZE TIMER
  FOR i=0 TO 39
    FOR j=0 TO 9
      DEFFILL RAND(16)
      PBOX i*8,j*10+100,i*8+7,j*10+109
    NEXT j
  NEXT i
  '
  ' ======== define blitter surfaces ========
  ' surface%(0) Adresse de la zone mémoire, doit être paire
  ' surface%(1) Largeur de la surface en pixels, doit être un multiple de 16
  ' surface%(2) Hauteur de la surface en pixels
  ' surface%(3) Largeur de la grille en mot (= surface%(1) div 16)
  ' surface%(4) RÉSERVÉ, toujours 0
  ' surface%(5) nombre de plan de couleurs (monochrome : 1 ; 4 couleurs : 2 ; 16 couleurs : 4 ; 256 couleurs : 8)
  '
  ERASE vblit_surface_source%(),vblit_surface_dest%()
  DIM vblit_surface_source%(6),vblit_surface_dest%(6)
  ' Top half of the screen
  '
  vblit_surface_source%(0)=xb%
  vblit_surface_source%(1)=320
  vblit_surface_source%(2)=100
  vblit_surface_source%(3)=vblit_surface_source%(1)/16
  vblit_surface_source%(4)=0
  vblit_surface_source%(5)=4
  '
  ' Bottom half of the screen
  '
  vblit_surface_dest%(0)=xb%+16000
  vblit_surface_dest%(1)=320
  vblit_surface_dest%(2)=100
  vblit_surface_dest%(3)=vblit_surface_dest%(1)/16
  vblit_surface_dest%(4)=0
  vblit_surface_dest%(5)=4
  '
  '
  ' ======== define blitting parameters and do blitting ========
  ' parametre%(0) coordonnées x du coin en haut à gauche, dans la surface source, du bloc à copier
  ' parametre%(1) coordonnées y du coin en haut à gauche, dans la surface source, du bloc à copier
  ' parametre%(2) coordonnées x du coin en bas à droite, dans la surface source, du bloc à copier
  ' parametre%(3) coordonnées y du coin en bas à droite, dans la surface source, du bloc à copier
  ' parametre%(4) coordonnées x du coin en haut à gauche, dans la surface cible, du bloc à copier
  ' parametre%(5) coordonnées y du coin en haut à gauche, dans la surface cible, du bloc à copier
  ' parametre%(6) coordonnées x du coin en bas à droite, dans la surface cible, du bloc à copier
  ' parametre%(7) coordonnées y du coin en bas à droite, dans la surface cible, du bloc à copier
  ' PARAM 8 MODE GRAPHIQUE
  ERASE vblit_param%()
  DIM vblit_param%(9)
  vblit_param%(0)=0
  vblit_param%(1)=0
  vblit_param%(2)=159
  vblit_param%(3)=99
  vblit_param%(4)=0
  vblit_param%(5)=0
  vblit_param%(6)=159
  vblit_param%(7)=99
  vblit_param%(8)=3
  '
RETURN
> PROCEDURE blitter(switch!)
  LOCAL status
  status=XBIOS(64,-1)
  IF BTST(status,1)           ! Blitter available?
    IF switch!
      status=BSET(status,0)   ! Blitter on
    ELSE
      status=BCLR(status,0)   ! Blitter off
    ENDIF
    ~XBIOS(64,status)         ! do it
  ENDIF
RETURN

' Initialisation and utils for GFA demo and games on ATARI ST in low res
' Big thanks to Lonny Pursell for all his help on compiling
' Hylst - v1.7 - 06/2011
'
hello ! general init
~INP(2)
bye ! restore everything
'
PROCEDURE hello
  ' compiler options
  $m500000 ! memory need for the program 2 be compiled - OR RESERVE...
  ' $I- ! disable interrupt routine  -  $I+{ would enable them
  ' $N- ! Disable FOR-NEXT range checking
  ' $S> ! Fast select case  -  $C< slower but shorter code
  ' $*& ! Longword multiplication with muls  -  $*% :  without
  ' $%3 ! Always execute integer division as an integer division  -   $%0 = opposite
  '
  sup%=GEMDOS(32,L:0) ! super
  compiled!=BYTE{BASEPAGE+256}<>96  ! false=interpreted/true=compiled
  IF NOT compiled!
    RESERVE 500000 ! if run under interpreter
  ENDIF
  oldrez&=XBIOS(4)  ! save reso
  oldlog%=XBIOS(3) ! save logical screen adress
  oldphy%=XBIOS(2) ! save logical screen adress
  screen%=MALLOC(32255) ! reserve memory for double screen buffer
  IF screen%<=0
    ~GEMDOS(32,L:sup%)
    IF NOT compiled!
      RESERVE
    ENDIF
    EDIT
  ENDIF
  log%=(screen%+255) AND &HFFFFFF00 ! Stf compatible adress for video shifter
  phy%=oldphy%
  ~XBIOS(5,L:phy%,L:log%,W:0) ! set the screens at these new adresses
  CLS  ! 0 low reso  1 medium  2 high  3 reserved 4 Falcon & more
  BMOVE phy%,log%,32000  ! clear new screens
  a|=BYTE{&HFF820D}
  BYTE{&HFF820D}=15
  b|=BYTE{&HFF820D}
  BYTE{&HFF820D}=a|
  IF a|<>b|  ! If Ste or Falcon (not STf not TT)
    blitter(TRUE)
  ENDIF
  DIM oldpal&(16)
  BMOVE &HFFFF8240,V:oldpal&(0),32
  DIM stzpal&(16)
  ARRAYFILL stzpal&(),0
  stzpal%=V:stzpal&(0)
  '  ~GRAF_MOUSE(256,0) ! =OUT 4,18 hide mouse (hidem don't work with patched libs)
  key|=BYTE{&H484}         ! save keyboard
  inter|=BYTE{&HFFFA09}    ! save interrupts
  SPOKE &H484,(PEEK(&H484) AND &HFE) ! keyboad sound off
  BYTE{&H484}=0            ! keyboard off
  CLIP 0,0,320,200 !required for patched libs otherwise gfx are not visible
  OUT 4,18
  ON ERROR GOSUB bye ! hope this doesn't slow program
  ON BREAK GOSUB bye ! to avoid disagreements in case...
RETURN
PROCEDURE bye
  '  ~GRAF_MOUSE(257,0) ! =OUT 4,8 show mouse (showm don't work with patched libs)
  ' ~MFREE(screen%) ! free screen buffer, not necessary at the end of the program : automatic
  ~XBIOS(5,L:oldphy%,L:oldlog%,oldrez&) ! back to old screens & reso
  ~XBIOS(6,L:V:oldpal&(0)) ! restore pal
  BYTE{&H484}=key|    ! restore keyboard
  BYTE{&HFFFA09}=inter|  !  restore interrupts
  {&H4D2}=0  ! music off
  WAVE 0,0   ! sound off
  OUT 4,8
  ~GEMDOS(32,L:sup%) ! user mode on
  IF NOT compiled!
    RESERVE
  ENDIF
  EDIT
RETURN
' optionnals
> PROCEDURE tdbug
  ' change alternatively background colour and wait space
  ' may help you to locate bugs
  nokey
  IF tdebug!
    SETCOLOR 0,&H421
    tdebug!=NOT tdebug!
  ELSE
    SETCOLOR 0,&H124
    tdebug!=NOT tdebug!
  ENDIF
  ~INP(2)
RETURN
> PROCEDURE pmul160
  ' for BMOVES, CARD and others...
  DIM t160&(200)
  FOR y|=1 TO 199
    t160&(y|)=ADD(160,t160&(PRED(y|)))
  NEXT y|
  ' ERASE t160&()
RETURN
> PROCEDURE nokey
  ' to make sure space is no longer bashed
  WHILE PEEK(&HFFFC02)=57
  WEND
RETURN
> PROCEDURE clearpal
  ' all colours to 0
  BMOVE stzpal%,&HFFFF8240,32
RETURN
> PROCEDURE dboff
  ' double buffering off
  xb%=XBIOS(2)
  ~XBIOS(5,L:xb%,L:xb%,-1)
RETURN
> PROCEDURE stab
  SWAP phy%,log% ! exchange adresses to display screen you just worked on
  ~XBIOS(5,L:phy%,L:log%,0) ! set the screens at these new adresses
  '  CARD{&HFFFF8240}=&H421 ! to check which part of the vbl is used
  VSYNC ! wait 4 whole screen to be displayed
  ' CARD{&HFFFF8240}=0
RETURN
> PROCEDURE fadeon
  ' fadeon palette at adress pal%
  ' Take care : using floatint point var !
  DIM r&(16),v&(16),b&(16),dr(16),dv(16),db(16) ! final rvb component then fp offset
  DIM ipal&(16) ! intermediate calculated pal
  FOR c&=0 TO 15 ! decode & store rvb components
    col&=CARD{pal%+c&+c&}
    r&(c&)=SHR(col&,8) AND 7
    v&(c&)=SHR(col&,4) AND 7
    b&(c&)=col& AND 7
    dr(c&)=r&(c&)/7 ! calculate offset
    dv(c&)=v&(c&)/7
    db(c&)=b&(c&)/7
  NEXT c&
  FOR ty&=0 TO 2 ! calculate colours
    FOR i&=0 TO 7
      it&=7-i&
      FOR ii&=0 TO 16
        IF ty&=0
          cr&=r&(ii&)-dr(ii&)*it&
        ELSE IF ty&=1
          cr&=r&(ii&)
          cb&=b&(ii&)-db(ii&)*it&
        ELSE IF ty&=2
          cr&=r&(ii&)
          cb&=b&(ii&)
          cv&=v&(ii&)-dv(ii&)*it&
        ENDIF
        ipal&(ii&)=OR(SHL(cr&,8),OR(SHL(cv&,4),cb&))
      NEXT ii&
      VSYNC
      VSYNC
      FOR ii&=0 TO 15  ! change colours
        CARD{&HFFFF8240+ii&+ii&}=ipal&(ii&)
      NEXT ii&
    NEXT i&
  NEXT ty&
  ERASE ipal&(),r&(),v&(),b&(),dr(),dv(),db()
RETURN
> PROCEDURE fadeoff
  pal%=&HFFFF8240
  ' fadeoff palette
  ' Take care : using floatint point var !
  DIM r&(16),v&(16),b&(16),dr(16),dv(16),db(16) ! final rvb component then fp offset
  DIM ipal&(16) ! intermediate calculated pal
  FOR c&=0 TO 15 ! decode & store rvb components
    col&=CARD{pal%+c&+c&}
    r&(c&)=SHR(col&,8) AND 7
    v&(c&)=SHR(col&,4) AND 7
    b&(c&)=col& AND 7
  NEXT c&
  FOR c&=0 TO 16
    dr(c&)=r&(c&)/7 ! calculate offset
    dv(c&)=v&(c&)/7
    db(c&)=b&(c&)/7
  NEXT c&
  FOR ty&=0 TO 2 ! calculate colours
    FOR i&=0 TO 7
      FOR ii&=0 TO 16
        IF ty&=0
          cb&=b&(ii&)
          cr&=r&(ii&)
          cv&=v&(ii&)-dv(ii&)*i&
        ELSE IF ty&=1
          cv&=v&(ii&)-dv(ii&)*7
          cr&=r&(ii&)
          cb&=b&(ii&)-db(ii&)*i&
        ELSE IF ty&=2
          cb&=b&(ii&)-db(ii&)*7
          cv&=v&(ii&)-dv(ii&)*7
          cr&=r&(ii&)-dr(ii&)*i&
        ENDIF
        ipal&(ii&)=OR(SHL(cr&,8),OR(SHL(cv&,4),cb&))
      NEXT ii&
      VSYNC
      VSYNC
      FOR ii&=0 TO 15  ! change colours
        CARD{&HFFFF8240+ii&+ii&}=ipal&(ii&)
      NEXT ii&
    NEXT i&
  NEXT ty&
  ERASE ipal&(),r&(),v&(),b&(),dr(),dv(),db()
RETURN
> PROCEDURE vdicol
  ' use gemcol|(couleur) with deffill, defftext, defmark, color, etc.
  ' to match vdi colours with linea or physical palette of video shifter &hffff8240
  RESTORE vdicolours
  DIM vdicol|(15)
  FOR i|=0 TO 15
    READ vdicol|(i&)
  NEXT i|
vdicolours:
  DATA 0,2,3,6,4,7,5,8,9,10,11,14,12,15,13,1
RETURN
PROCEDURE blitter(switch!)
  status&=XBIOS(64,-1)
  IF BTST(status&,1)           ! Blitter available?
    IF switch!
      status&=BSET(status&,0)   ! Blitter on
    ELSE
      status&=BCLR(status&,0)   ! Blitter off
    ENDIF
    ~XBIOS(64,status&)         ! do it
  ENDIF
RETURN

EN CONSTRUCTION