' *** STANLOW.LST ***           (delete this line)
'
' ==============================================================================
' ********************
' ***         .GFA ***
' ********************
' *** this program runs in Low resolution only
'
' ------------------------------------------------------------------------------
'                             *** Initiation ***
'
DEFWRD "a-z"                    ! word variables (-32768 to +32767) default !!
@initio
'
' @title.screen("TITLE",".. .... 1990",32)        ! activate in finished program
' ON BREAK GOSUB break                            ! activate in finished program
'
' ------------------------------------------------------------------------------
'                            *** Main Program ***
'
'
'
EDIT                            ! use this while developing program
' @exit                         ! use this in finished program
'
' ------------------------------------------------------------------------------
'                     *** Standard Globals and Array ***
'
> PROCEDURE initio
  LOCAL w,h,n
  '
  CLS
  @low.mode
  '
  @get.path(default.path$)
  '
  physbase%=XBIOS(2)            ! physical screen
  logbase%=XBIOS(3)             ! logical screen
  '
  low.res!=TRUE
  scrn.x.max=WORK_OUT(0)                              ! 319 (regular monitor)
  scrn.y.max=WORK_OUT(1)                              ! 199
  ~GRAF_HANDLE(char.width,char.height,w,h)            ! 8x8 font
  scrn.col.max=DIV(SUCC(scrn.x.max),char.width)       ! 40
  scrn.lin.max=DIV(SUCC(scrn.y.max),char.height)      ! 25
  '
  white=0             ! default Low colors
  black=1
  red=2
  green=3
  blue=4
  d.blue=5
  brown=6
  d.green=7
  grey=8
  l.black=9
  l.blue=10
  bluegreen=11
  l.purple=12
  d.purple=13
  d.yellow=14
  l.yellow=15
  DEFTEXT black,0,0,6
  '
  ' *** Standard Array color.index()
  ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index
  RESTORE col.index.low
  DIM color.index(15)
  FOR n=0 TO 15
    READ color.index(n)
  NEXT n
  @standard.low.colors
  '
  col.index.low:
  DATA 0,15,1,2,4,6,3,5,7,8,9,10,12,14,11,13
  '
  on!=TRUE
  off!=FALSE
  '
  bel$=CHR$(7)
  '
  return$=CHR$(13)
  esc$=CHR$(27)
  help$=CHR$(0)+CHR$(98)
  undo$=CHR$(0)+CHR$(97)
  '
  interpreter$="\GFABASIC.PRG"  ! change path if necessary
  run.only$="\GFABASRO.PRG"     ! Run-Only Interpreter
  start.gfa$="\STARTLOW.GFA"    ! 'Shell' for GFA-programs (Low rez)
  start.prg$="\GFASTART.PRG"    ! 'Shell' for compiled GFA-programs
  '
RETURN
' **********
'
' ------------------------------------------------------------------------------
'                          *** Standard Functions ***
'
DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$
DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q"
DEFFN ink$(color)=CHR$(27)+"b"+CHR$(color.index(color))
DEFFN paper$(color)=CHR$(27)+"c"+CHR$(color.index(color))
'
' ------------------------------------------------------------------------------
'                         *** Standard Procedures ***
'
> PROCEDURE low.mode
  LOCAL m$,button
  IF XBIOS(4)<>0
    SOUND 1,10,12,4,25
    SOUND 1,10,6,4,25
    SOUND 1,10,12,4,50
    SOUND 1,0
    m$="Sorry, you should|use Low resolution|for this program"
    ALERT 3,m$,1," OK ",button
    @exit
  ENDIF
RETURN
' **********
'
> PROCEDURE get.path(VAR default.path$)
  ' *** return default path (current drive and folder)
  ' *** example - A:\GAMES\
  ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\
  ' ***                          (even if program not in main directory !!)
  LOCAL default.drive,default.drive$
  CLR default.path$
  default.drive=GEMDOS(&H19)
  default.drive$=CHR$(default.drive+65)
  default.path$=DIR$(default.drive+1)
  IF default.path$<>""
    default.path$=default.drive$+":"+default.path$+"\"
  ELSE
    default.path$=default.drive$+":\"
  ENDIF
RETURN
' **********
'
> PROCEDURE standard.low.colors
  ' *** standard-colors for Low resolution
  LOCAL n,col$,r,g,b
  RESTORE col.data
  FOR n=0 TO 15
    READ col$
    r=VAL(LEFT$(col$))
    g=VAL(MID$(col$,2,1))
    b=VAL(RIGHT$(col$))
    VSETCOLOR n,r,g,b
  NEXT n
  '
  col.data:
  DATA 777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770
RETURN
' **********
'
> PROCEDURE title.screen(title$,datum$,height)
  ' *** standard title-screen
  ' *** uses Standard Globals and Standard Procedure Return.key
  LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i
  CLS
  HIDEM
  DEFTEXT black,8,0,height
  x=(scrn.x.max-LEN(title$)*height/2)/2
  y=scrn.y.max/2
  TEXT x,y,title$
  LET name$="½ Han Kempen"      ! that's me
  col=(scrn.col.max-12)/2
  lin=scrn.lin.max/2+6
  PRINT AT(col,lin);name$
  x1=(col-2)*8
  y1=(lin-1)*char.height-4
  x2=x1+LEN(name$)*8+16
  y2=y1+char.height+8
  BOX x1,y1,x2,y2
  DEFLINE 1,3
  DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3
  LINE x1+3,y2+1,x2+2,y2+1
  PRINT AT(col,lin+2);datum$
  @return.key
  COLOR black
  DEFLINE 1,1
  FOR i=0 TO y
    BOX i,i,scrn.x.max-i,scrn.y.max-i
  NEXT i
  COLOR white
  FOR i=y DOWNTO 0
    BOX i,i,scrn.x.max-i,scrn.y.max-i
  NEXT i
  COLOR black
  CLS
RETURN
' **********
'
> PROCEDURE return.key
  ' *** wait for <Return>
  ' *** after pressing any other key, flashing 'RETURN' is turned off
  ' *** uses Standard Globals
  LOCAL w1$,w2$,temp$,in$
  CLR in$
  REPEAT
  UNTIL INKEY$=""
  GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$
  w1$="<RETURN>"
  w2$=SPACE$(8)
  PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;
  WHILE in$=""                              ! wait for any key
    PAUSE 30
    SWAP w1$,w2$
    PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;
    in$=INKEY$
  WEND
  PUT 0,scrn.y.max-char.height,temp$,3    ! restore screen
  WHILE in$<>return$                      ! wait for <Return>
    in$=INKEY$
  WEND
RETURN
' **********
'
> PROCEDURE break
  ' *** activate in main program with : ON BREAK GOSUB break
  ' *** do not use while developing program !
  LOCAL m$,k
  ON BREAK CONT
  m$="*** Break ***|Continue,|Run again|or Quit"
  ALERT 3,m$,1,"CONT|RUN|QUIT",k
  SELECT k
  CASE 1
    ON BREAK                            ! true break possible for emergency
    m$="Freeze current|screen (press|any key to|continue)"
    ALERT 2,m$,2,"YES|NO",k
    IF k=1
      REPEAT
      UNTIL LEN(INKEY$) OR MOUSEK
    ENDIF
    ON BREAK GOSUB break
  CASE 2
    RUN
  CASE 3
    @exit
  ENDSELECT
RETURN
' **********
'
> PROCEDURE exit
  ' *** exit program
  CLS
  IF EXIST(interpreter$) OR EXIST(run.only$)
    ' *** program was run from (Run-Only) Interpreter
    IF EXIST(start.gfa$)
      CHAIN start.gfa$          ! back to 'shell'-program
    ELSE
      EDIT                      ! no shell
    ENDIF
  ELSE IF EXIST(start.gfa$)
    ' *** can't find interpreter, but here is the 'shell'-program
    CHAIN start.gfa$
  ELSE IF EXIST(start.prg$)
    ' *** compiled program started from shell
    CHAIN start.prg$            ! back to shell
  ELSE
    ' *** compiled program
    SYSTEM                      ! no shell
  ENDIF
RETURN
' **********
'
' ------------------------------------------------------------------------------
'                               *** Procedures ***
'
'
'
'
' ------------------------------------------------------------------------------
'                                *** The End ***
' ==============================================================================