' Correct Resolution Setter, featuring double buffer ;)
' Cooper/Pdz - 2005
'
RESERVE 200000
'
ecrans%=MALLOC(64256)
ecran1%=AND(ADD(ecrans%,255),&HFFFFFF00)
ecran2%=ADD(ecran1%,32000)
'
DIM palette(16)
'
@test_ste
@resol
@sauve_palette
'
SETCOLOR 0,0,3,3
SETCOLOR 15,7,7,7
PRINT "Welcome in low res !"
PRINT "Med-res is crap :-)"
~INP(2)
initialisation_double_buffer     ! set on the double buffer
' awesome fx here :)
@fin_double_buffer               ! double buffer end
'
@restore_video_mode
@restaure_palette
~MFREE(ecrans%)
RESERVE
'
> PROCEDURE initialisation_double_buffer
  old_phy%=XBIOS(2)
  old_log%=XBIOS(3)
  VSYNC
  CLS
  '
  BMOVE XBIOS(2),ecran1%,32000
  BMOVE XBIOS(2),ecran2%,32000
  '
  ~XBIOS(5,L:ecran2%,L:ecran1%,W:-1)
  CLS
  BMOVE ecran2%,ecran1%,32000
RETURN
> PROCEDURE fin_double_buffer
  CLS
  ~XBIOS(5,L:old_log%,L:old_phy%,W:-1)  ! on remet les anciennes adresses
RETURN
> PROCEDURE new_video_mode(mode%)
  VOID XBIOS(5,L:-1,L:-1,W:3,W:mode%)
RETURN
> PROCEDURE restore_video_mode
  IF falcon!=TRUE
    VOID XBIOS(5,L:-1,L:-1,W:3,old_video_mode%)
  ELSE
    VOID XBIOS(5,L:-1,L:-1,rez%)
  ENDIF
RETURN
> FUNCTION cookie_find(id$)
LOCAL c_ptr%,cname%,c_val%
c_ptr%=LPEEK(&H5A0)                 ! start of list (cookie-jar)
IF OR(c_ptr%=0,ODD(c_ptr%))
  RETURN 0                         ! error: cookiejar does not exist
ELSE
  REPEAT
    cname%=LPEEK(c_ptr%)
    c_val%=LPEEK(c_ptr%+4)
    EXIT IF cname%=0          ! end of list
    ADD c_ptr%,8
  UNTIL MKL$(cname%)=id$          ! cookie found
  IF cname%
    RETURN c_val%                ! return its value
  ENDIF
  RETURN -1                       ! jar exists; cookie not found
ENDIF
ENDFUNC
> PROCEDURE test_ste
a|=PEEK(&HFF820D)
SPOKE &HFF820D,15
b|=PEEK(&HFF820D)
SPOKE &HFF820D,a|
IF a|<>b|
  ste!=TRUE
  falcon!=FALSE
  stf!=FALSE
  IF @cookie_find("_SND")=31
    falcon!=TRUE
    ste!=FALSE
    stf!=FALSE
    PRINT "falcon detected !"
  ELSE
    PRINT "STE detected !"
  ENDIF
ELSE
  PRINT "STF detected !"
  stf!=TRUE
  falcon!=FALSE
  ste!=FALSE
ENDIF
RETURN
> PROCEDURE resol
rez%=XBIOS(4)
IF falcon!=TRUE
  old_video_mode%=XBIOS(88,W:-1)                !save old video mode
  new_video_mode(434)                           !go STlow (temporary)
  nb_couleurs_a_sauver|=16
  @sauve_palette
ELSE
  IF rez%=0
    nb_couleurs_a_sauver|=16
    @sauve_palette
  ENDIF
  IF rez%=1
    nb_couleurs_a_sauver|=4
    @sauve_palette
    VSYNC
    ~XBIOS(5,L:-1,L:-1,W:0)
  ENDIF
  IF XBIOS(4)=2
    @fin
  ENDIF
ENDIF
RETURN
> PROCEDURE sauve_palette
LOCAL ctr%
FOR ctr%=0 TO nb_couleurs_a_sauver|-1
  palette(ctr%)=XBIOS(7,W:ctr%,W:-1)
NEXT ctr%
RETURN
> PROCEDURE restaure_palette
LOCAL ctr%
FOR ctr%=0 TO nb_couleurs_a_sauver|-1
  SETCOLOR ctr%,palette(ctr%)
NEXT ctr%
RETURN
> PROCEDURE fin
EDIT
RETURN
'