'
' 007.BAS
' (C) 2/23/1990, by PKF
' GfA Basic v2.02
'
If Xbios(4)<>2
  Alert 3,"!!",1,"HI-REZ",A%
  End
Endif
Setcolor 0,1
A$=Chr$(66)+Chr$(121)+Chr$(32)+Chr$(80)+Chr$(105)+Chr$(101)+Chr$(114)+Chr$(101)+Chr$(109)+Chr$(105)+Chr$(108)+Chr$(105)+Chr$(111)+Chr$(32)+Chr$(70)+Chr$(97)+Chr$(114)+Chr$(105)+Chr$(110)+Chr$(97)
@Rsrc_load("007.RSC")
@Appl_init
@Rsrc_gaddr(0,0)
@Form_center(Re_gaddr)
@Form_dial(1,1,1,1,1,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
@Objc_draw(Re_gaddr,0,2,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
Print At(31,19);A$
Text 200,342,"Run"
Text 412,342,"Quit"
Text 120,130,"ASCII char #28"
Text 400,130,"ASCII char #29"
Text 120,256,"ASCII char #30"
Text 400,256,"ASCII char #31"
Deftext ,,,32
Text 244,130,""
Text 368,130,""
Text 244,270,""
Text 368,270,""
Deftext ,,,13
@Form_do(Re_gaddr,-1)
If Dpeek(Gintout)=1
  Dpoke Re_gaddr+34,0
  Dpoke Re_gaddr+58,0
  @Objc_draw(Re_gaddr,0,2,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
  Print At(31,19);A$
  Text 172,342,"Who is it?"
  Text 388,342,"Who cares!"
  For A%=0 To 54
    Deftext ,,,32
    Text 244+A%,130+A%,""
    Text 368-A%,130+A%,""
    Text 244+A%,270-A%,""
    Text 368-A%,270-A%,""
    Deftext ,,,13
    Text 120+A%,130+A%,"ASCII char #28"
    Text 400-A%,130+A%,"ASCII char #29"
    Text 120+A%,256-A%,"ASCII char #30"
    Text 400-A%,256-A%,"ASCII char #31"
  Next A%
  @Form_do(Re_gaddr,-1)
  If Dpeek(Gintout)=1
    Alert 0,"If you really know that, you|can give a look into the old|version of TOS - 1.0 - at the |hex locations $FCF3C8-$FCF3E4",1,"Thanks",Pkf%
  Endif
Endif
@Form_dial(3,1,1,1,1,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
@Form_dial(2,1,1,1,1,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
@Rsrc_free
@Appl_exit
End
'
' AES
'
Procedure Appl_init
  Dpoke Gcontrl,10
  Dpoke Gcontrl+2,0
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,0
  Dpoke Gcontrl+8,0
  Gemsys
Return
Procedure Appl_exit
  Dpoke Gcontrl,19
  Dpoke Gcontrl+2,0
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,0
  Dpoke Gcontrl+8,0
  Gemsys
Return
Procedure Objc_draw(Re_gaddr,Ob_start,Flag,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
  Dpoke Gcontrl,42
  Dpoke Gcontrl+2,6
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,1
  Dpoke Gcontrl+8,0
  Dpoke Gintin,Ob_start
  Dpoke Gintin+2,Flag
  Dpoke Gintin+4,Fo_cx
  Dpoke Gintin+6,Fo_cy
  Dpoke Gintin+8,Fo_cw
  Dpoke Gintin+10,Fo_ch
  Lpoke Addrin,Re_gaddr
  Gemsys
Return
Procedure Form_do(Re_gaddr,Ob_start)
  Dpoke Gcontrl,50
  Dpoke Gcontrl+2,1
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,1
  Dpoke Gcontrl+8,0
  Dpoke Gintin,Ob_start
  Lpoke Addrin,Re_gaddr
  Gemsys
  Fo_doreturn=Dpeek(Gintout)
Return
Procedure Form_dial(Flag,Fo_dx,Fo_dy,Fo_dw,Fo_dh,Fo_cx,Fo_cy,Fo_cw,Fo_ch)
  Dpoke Gcontrl,51
  Dpoke Gcontrl+2,9
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,0
  Dpoke Gcontrl+8,0
  Dpoke Gintin,Flag
  Dpoke Gintin+2,Fo_dx
  Dpoke Gintin+4,Fo_dy
  Dpoke Gintin+6,Fo_dw
  Dpoke Gintin+8,Fo_dh
  Dpoke Gintin+10,Fo_cx
  Dpoke Gintin+12,Fo_cy
  Dpoke Gintin+14,Fo_cw
  Dpoke Gintin+16,Fo_ch
  Gemsys
Return
Procedure Form_center(Re_gaddr)
  Dpoke Gcontrl,54
  Dpoke Gcontrl+2,0
  Dpoke Gcontrl+4,5
  Dpoke Gcontrl+6,1
  Dpoke Gcontrl+8,0
  Lpoke Addrin,Re_gaddr
  Gemsys
  Fo_cx=Dpeek(Gintout+2)
  Fo_cy=Dpeek(Gintout+4)
  Fo_cw=Dpeek(Gintout+6)
  Fo_ch=Dpeek(Gintout+8)
Return
Procedure Rsrc_load(Re_lpfname$)
  Re_lpfname$=Re_lpfname$+Chr$(0)
  Dpoke Gcontrl,110
  Dpoke Gcontrl+2,0
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,1
  Dpoke Gcontrl+8,0
  Lpoke Addrin,Varptr(Re_lpfname$)
  Gemsys
  If Dpeek(Gintout)=0
    Alert 3,"File .RSC|not found!",1,"Abort",A%
    End
  Endif
Return
Procedure Rsrc_free
  Dpoke Gcontrl,111
  Dpoke Gcontrl+2,0
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,0
  Dpoke Gcontrl+8,0
  Gemsys
Return
Procedure Rsrc_gaddr(Flag,Ob_start)
  Dpoke Gcontrl,112
  Dpoke Gcontrl+2,2
  Dpoke Gcontrl+4,1
  Dpoke Gcontrl+6,0
  Dpoke Gcontrl+8,1
  Dpoke Gintin,Flag
  Dpoke Gintin+2,Ob_start
  Gemsys
  Re_gaddr=Lpeek(Addrout)
Return