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.html – http://3430.online.fr/atari_st/texts/gfa.htm – http://supertos.free.fr/