GFA is a BASIC computer language realized by Frank Ostrowski (1986) for ATARI ST computers (MC68000 processor, GEM interface, Tramiel Operating System).
It has evolved over years and is now able to compilate with relative good speed efficiency for a BASIC language.
The success of GFA is mainly due to its power, its versatility and its comfort of use.
GFA Basic is a structured programming language with many similarities with C language.
It includes foldable procedures and functions in the editor. Its instructions use almost all areas (math, editing, graphics, files) and machine resources (BIOS, GEMDOS, XBIOS).
It allows C / ASM call quite easily, direct memory access, and with latest version good possibilities to set specific compilation options.
The other key to its success is the ability to describe instructions in extremely short « sentences ». This is due to the great flexibility of algebraic expressions and the non-declaration of variables which greatly clarifies the listings.

Latest evolution of GFA interpreter, compiler & linker, Mint friendly were done by Lonny Pursell and can be found here.


I’ve started coding GFA when i was about 12 years old. I’m a very casual coder. Before i had an internet access (lately), i was working with a very old and probably not fully functional version of GFA compiler / linker.
I’ve coded most of my (lazy 🤔😓😁) productions with this language about 20/25 years ago.

I want to share here many sources.
Need to find room to unbox my old atari ST & many floppy disks which should be somewhere in my cave 🙄
If that disks still works too…

I’ve made some tests on GFA, especially speed tests to check what kind of code is better to use
according to the speed of the compiled code / executable.

Maybe useful GFA listing about :

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



USEFUL LINKS ABOUT GFA FOR ATARI ST

http://gfabasic.net/https://gfa-basic.forumactif.com/

http://freddo.chez.com/GfaBasic/GfaBasic.htmlhttp://3430.online.fr/atari_st/texts/gfa.htmhttp://supertos.free.fr/


%d blogueurs aiment cette page :