pearl.lst

$M 128000 $S> $F< $P< $%0 $*% $O3 $A2 $E$
'
REM #KEY ColdFire v4e|Classic 68K
REM #IFK 0
REM #BRK MA
REM #EIK 1 ! ColdFire v4e
REM #LIB ColdFire
REM #EXT prx
REM #EIK 2 ! Classic 68K
REM #LIB 68000
REM #EXT prg
REM #FIK
'
IF FATAL
  ~FORM_ALERT(1,"[1][ This version is not suited | for this CPU. Please get | the correct archive. ][ Ok ]")
  @leave
ENDIF
IF ERR=8
  ~FORM_ALERT(1,"[1][ Insuffisant or fragmented | memory ][ Ok ]")
  @leave
ELSE
  init1
  init2
  main
ENDIF
'
> PROCEDURE leave
  IF offscreen_enabled!
    V~H=off_handle&
    ~V_CLSBM()
    V~H=-1
  ENDIF
  @mxfree(offscreen_pointer%)
  @mxfree(offscreen_work_buffer%)
  '
  @restore_colors
  @mxfree(palette_save%)
  @mxfree(palette_work%)
  FOR i&=1 TO img_nb_slots&
    IF LONG{img_mfdb%(i&)}>0
      @mxfree(LONG{img_mfdb%(i&)})
    ENDIF
  NEXT i&
  @mxfree(mfdb_structure%)
  @close_win
  '
  @mxfree(mfdb_screen%)
  IF ressource!
    ~MENU_BAR(ressource_menu%,0)
    ~RSRC_FREE()
  ENDIF
  QUIT
RETURN
'
> PROCEDURE init1
  '
  IF A~I<0 ! appl_init() failed?
    @leave
  ENDIF
  '
  IF _B<8
    ~FORM_ALERT(1,"[1][ Need at least 256 colors ][ Quit ]")
    @leave
  ENDIF
  '
  mx_mask%=@mx_mask
  mxalloc!=(_GEMDOS>=&H19)
  '
  magic!=GETCOOKIE(CVL("MagX"))
  mint!=(_MINT<>0) ! GETCOOKIE(CVL("MiNT"))
  '
  IF magic! OR mint!
    naes!=TRUE
  ELSE IF _AES>=&H399
    naes!=TRUE
  ELSE
    naes!=FALSE
  ENDIF
  '
  multi!=MULTITASK?
  '
  @declare
  @declare_effect
  IF mint!=FALSE
    RESERVE 32000
  ENDIF
  @allocate
  '
  ~RSRC_FREE()
  IF EXIST(ressource_file$)
    IF RSRC_LOAD(ressource_file$)<>0
      ~RSRC_GADDR(0,0,ressource_menu%)
      ressource!=TRUE
    ENDIF
  ENDIF
  '
RETURN
> PROCEDURE declare
  general_path$=CURDIR$
  '
  application_path$=general_path$+"PEARL.DAT\"
  '
  ressource_file$=general_path$+"PEARL.RSC"
  ressource!=FALSE
  ressource_menu%=0
  '
  preferences_file$=general_path$+"VDI_FX.INF"
  '
  DIM boolean$(2)
  boolean$(0)="FALSE"
  boolean$(1)="TRUE"
  '
  hand_win&=0
  xd&=0
  yd&=0
  ld&=0
  hd&=0
  wx&=_DX
  wy&=_DY
  wl&=_DW
  wh&=_DH
  win!=FALSE
  aff!=FALSE
  cp_win&=&X0
  '
  bitplane_number&=_B
  '
  pixel_width_micron&=WORK_OUT(3)
  pixel_height_micron&=WORK_OUT(4)
  '
  force_memory_allocation!=TRUE
  '
  offscreen_enabled!=FALSE
  offscreen_size%=0
  offscreen_pointer%=0
  '
  ' number of slots for images pool
  img_nb_slots&=4
  '
  ' MFDB and coord of the images
  DIM img_mfdb%(img_nb_slots&),img_dx(img_nb_slots&)
  DIM img_x&(img_nb_slots&),img_y&(img_nb_slots&)
  DIM img_w&(img_nb_slots&),img_h&(img_nb_slots&)
  '
  ' pointer to loaded DGX file (group of DGI) or DGI file if not existing
  dgx_adr%=0
  dgx_buffer_len%=400000
  old_dgx_filename$=""
  '
  ' transcodage table for pixel value<->color of the palette
  DIM trans_pal|(255)
  trans_pal|(0)=0
  trans_pal|(1)=2
  trans_pal|(2)=3
  trans_pal|(3)=6
  trans_pal|(4)=4
  trans_pal|(5)=7
  trans_pal|(6)=5
  trans_pal|(7)=8
  trans_pal|(8)=9
  trans_pal|(9)=10
  trans_pal|(10)=11
  trans_pal|(11)=14
  trans_pal|(12)=12
  trans_pal|(13)=15
  trans_pal|(14)=13
  trans_pal|(15)=255
  FOR i&=16 TO 254
    trans_pal|(i&)=i&
  NEXT i&
  trans_pal|(255)=1
  '
RETURN
> PROCEDURE declare_offscreen(offscreen_width&,offscreen_height&)
  '
  offscreen_enabled!=FALSE
  '
  offscreen_work_buffer%=@mxalloc(56,3)
  IF offscreen_work_buffer%>0
    '
    pxy%=offscreen_work_buffer%   ! zone des coordonn‚es
    scr_mfdb%=ADD(pxy%,16)       ! descripteur de raster pour l'‚cran vdi normal
    off_mfdb%=ADD(scr_mfdb%,20) ! descripteur de raster pour l'‚cran offscreen
    '
    ' on renseigne le descripteur de l'‚cran vdi
    '
    LONG{ADD(scr_mfdb%,0)}=0 ! si … 0, alors il considŠre que c l'‚cran vdi normal
    INT{ADD(scr_mfdb%,4)}=ADD(_DX,_DW)
    INT{ADD(scr_mfdb%,6)}=ADD(_DY,_DH)
    INT{ADD(scr_mfdb%,8)}=SHR&(ADD(INT{ADD(scr_mfdb%,4)},15),4)
    INT{ADD(scr_mfdb%,10)}=0
    INT{ADD(scr_mfdb%,12)}=bitplane_number&
    INT{ADD(scr_mfdb%,14)}=0
    INT{ADD(scr_mfdb%,16)}=0
    INT{ADD(scr_mfdb%,18)}=0
    '
    ' on alloue la m‚moire pour l'‚cran offscreen
    '
    IF force_memory_allocation!
      offscreen_size%=SHR&(ADD(offscreen_width&,15),4) ! largeur en mot
      MUL offscreen_size%,offscreen_height&            ! * la hauteur en pixel
      MUL offscreen_size%,2                            ! taille de mots en octets
      MUL offscreen_size%,bitplane_number&           ! * le nombre de plans
      '
      offscreen_pointer%=@mxalloc(ADD(offscreen_size%,32),3)
      IF offscreen_pointer%<1
        ~FORM_ALERT(1,"[1][ Not enough memory | for offscreen bitmap ][ Ok ]")
        offscreen_size%=0
      ENDIF
    ENDIF
    '
    ' on remplie le descripteur de l'‚cran offscreen
    '
    LONG{ADD(off_mfdb%,0)}=offscreen_pointer% ! adresse de la zone m‚moire
    INT{ADD(off_mfdb%,4)}=offscreen_width& ! largeur en pixel
    INT{ADD(off_mfdb%,6)}=offscreen_height& ! hauteur en pixel
    INT{ADD(off_mfdb%,8)}=SHR&(ADD(offscreen_width&,15),4)  ! largeur en mot
    INT{ADD(off_mfdb%,10)}=0 ! format sp‚cifique au hardware (sinon 1 : format VDI ‚changeable)
    INT{ADD(off_mfdb%,12)}=bitplane_number&
    INT{ADD(off_mfdb%,14)}=0
    INT{ADD(off_mfdb%,16)}=0
    INT{ADD(off_mfdb%,18)}=0
  ENDIF
  '
  IF GETCOOKIE(CVL("EdDI"))=TRUE AND offscreen_pointer%>0
    '
    INTIN(0)=1
    INTIN(1)=1
    INTIN(2)=1
    INTIN(3)=1
    INTIN(4)=1
    INTIN(5)=1
    INTIN(6)=1
    INTIN(7)=1
    INTIN(8)=1
    INTIN(9)=1
    INTIN(10)=2
    INTIN(11)=PRED(offscreen_width&)
    INTIN(12)=PRED(offscreen_height&)
    INTIN(13)=pixel_width_micron&
    INTIN(14)=pixel_height_micron&
    INTIN(15)=0
    INTIN(16)=0
    INTIN(17)=0
    INTIN(18)=0
    INTIN(19)=0
    '
    off_handle&=V_OPNBM(off_mfdb%,GRAF_HANDLE())
    '
    offscreen_enabled!=(off_handle&>0)
    '
  ENDIF
  '
RETURN
> PROCEDURE allocate
  '
  palette_save%=@mxalloc(1536,3)
  palette_work%=@mxalloc(1536,3)
  '
  ' pxy array and MFDB strutures
  mfdb_structure%=@mxalloc(SHL(SHR(ADD(MUL(20,SUCC(img_nb_slots&)),31),4),4),3)
  IF mfdb_structure%>0
    FOR i&=0 TO img_nb_slots&
      img_mfdb%(i&)=ADD(ADD(mfdb_structure%,16),MUL(i&,20))
      '
      LONG{img_mfdb%(i&)}=0
      LONG{ADD(img_mfdb%(i&),4)}=0
      LONG{ADD(img_mfdb%(i&),8)}=0
      LONG{ADD(img_mfdb%(i&),12)}=0
      LONG{ADD(img_mfdb%(i&),16)}=0
    NEXT i&
  ELSE
    @leave
  ENDIF
  '
RETURN
> PROCEDURE init2
  '
  ~VSF_INTERIOR(1)
  ~VSF_STYLE(0)
  ~VSF_COLOR(1)
  ~VSF_PERIMETER(0)
  IF offscreen_enabled!
    V~H=off_handle&
    ~VSF_INTERIOR(1)
    ~VSF_STYLE(0)
    ~VSF_COLOR(1)
    ~VSF_PERIMETER(0)
    V~H=-1
  ENDIF
  @save_colors
  '
  IF ressource!
    ~MENU_IENABLE(ressource_menu%,3,0)
    ~MENU_BAR(ressource_menu%,1)
  ENDIF
  IF multi!=FALSE
    ~FORM_DIAL(3,0,0,0,0,_DX,_DY,_DW,_DH)
  ENDIF
  '
RETURN
'
> PROCEDURE declare_effect
  LOCAL pref_len%
  '
  IF EXIST(preferences_file$)
    '
    mem_pos%=0
    '
    file_handle&=FOPEN(preferences_file$,0)
    IF file_handle&>0
      '
      pref_len%=FSEEK(0,file_handle&,2)
      ~FSEEK(0,file_handle&,0)
      '
      IF pref_len%>0
        mem_pos%=@mem_init(pref_len%)
        '
        IF mem_pos%>0
          IF FREAD(file_handle&,pref_len%,mem_pos%)<>pref_len%
            mem_pos%=@mem_close
          ENDIF
        ENDIF
      ENDIF
      ~FCLOSE(file_handle&)
    ENDIF
    '
    IF mem_pos%>0
      '
      mem_start_ptr%=mem_pos%
      mem_end_ptr%=ADD(mem_pos%,pref_len%)
      DO
        IF BYTE{mem_start_ptr%}=13 OR BYTE{mem_start_ptr%}=10
          BYTE{mem_start_ptr%}=0
        ENDIF
        INC mem_start_ptr%
      LOOP UNTIL mem_start_ptr%>mem_end_ptr%
      mem_start_ptr%=mem_pos%
      '
      univers_pixel_size&=MAX(1,MIN(VAL(@mem_find$("PEARL_PIXEL_SIZE")),8))
      univers_delay&=MAX(0,MIN(VAL(@mem_find$("PEARL_DELAY")),200))
      univers_force_offscreen!=@mem_get_flag("PEARL_USE_OFFSCREEN",TRUE)
      univers_clipped!=@mem_get_flag("PEARL_CLIPPED",TRUE)
      '
    ENDIF
    '
    ~@mem_close
    '
  ELSE
    '
    univers_pixel_size&=5
    univers_delay&=0
    univers_force_offscreen!=FALSE
    univers_clipped!=TRUE
    '
  ENDIF
RETURN
'
> FUNCTION mem_init(mem_wished_len%)
  $F%
  ~@mem_close
  mem_len%=MAX(16000,SHL(SHR(ADD(mem_wished_len%,31),4),4))
  mem_start_adr%=@mxalloc(mem_len%,3)
  IF mem_start_adr%<0
    ' alert ?
    mem_start_adr%=0
  ENDIF
  RETURN mem_start_adr%
ENDFUNC
> FUNCTION mem_close
  $F%
  IF mem_start_adr%>0
    @mxfree(mem_start_adr%)
    mem_start_adr%=0
    mem_len%=0
  ENDIF
  RETURN 0
ENDFUNC
> FUNCTION mem_find$(mem_key$)
  LOCAL mem_find_line$,mem_find_ptr%
  IF mem_start_ptr%>0 AND mem_end_ptr%>mem_start_ptr%
    mem_find_ptr%=mem_start_ptr%
    DO
      mem_find_line$=CHAR{mem_find_ptr%}
      ADD mem_find_ptr%,SUCC(LEN(mem_find_line$))
      '
      IF INSTR(mem_find_line$,mem_key$+"=")=1
        mem_str$=MID$(mem_find_line$,ADD(LEN(mem_key$),2))
        mem_pos&=INSTR(mem_str$,"#")
        IF mem_pos&>0
          RETURN TRIM$(LEFT$(mem_str$,PRED(mem_pos&)))
        ENDIF
        RETURN TRIM$(mem_str$)
      ENDIF
      '
    LOOP UNTIL mem_find_ptr%>=mem_end_ptr%
  ENDIF
  RETURN ""
ENDFUNC
> FUNCTION mem_get_flag(find_str$,default_flag!)
  $F%
  '
  IF @mem_find$(find_str$)=boolean$(ABS(NOT default_flag!))
    RETURN NOT default_flag!
  ENDIF
  RETURN default_flag!
ENDFUNC
'
> PROCEDURE load_images
  '
  IF EXIST(application_path$+"PEARL.DGI")=FALSE
    ~FORM_ALERT(1,"[1][ Need PEARL.DGI file ][ Quit ]")
    @leave
  ENDIF
  '
  img_x&(4)=0
  img_y&(4)=0
  img_w&(4)=64
  img_h&(4)=64
  ~@load_image_data(4,"PEARL")
  '
  @mxfree(dgx_adr%)
  dgx_adr%=0
  '
RETURN
> FUNCTION load_image_data(pimg_id&,pimg_name$)
  $F%
  LOCAL file_adr%,mfdb_adr%,dummy_adr%,dummy_size%,file_i&,file_j&
  ~FRE(0)
  '
  good!=FALSE
  '
  pimg_name$=application_path$+pimg_name$+".DGI"
  '
  file_adr%=@load_dgx(pimg_name$)
  IF file_adr%>0
    IF INT{ADD(file_adr%,12)}=8 AND MKL$(LONG{file_adr%})="_DGI"
      LONG{file_adr%}=ADD(file_adr%,20)
      '
      mfdb_adr%=img_mfdb%(pimg_id&)
      LONG{mfdb_adr%}=@mxalloc(ADD(MUL(MUL(INT{ADD(file_adr%,6)},INT{ADD(file_adr%,8)}),SHL&(bitplane_number&,1)),16),3)
      INT{ADD(mfdb_adr%,4)}=INT{ADD(file_adr%,4)}
      INT{ADD(mfdb_adr%,6)}=INT{ADD(file_adr%,6)}
      INT{ADD(mfdb_adr%,8)}=INT{ADD(file_adr%,8)}
      INT{ADD(mfdb_adr%,10)}=0
      IF mode_32k!
        INT{ADD(mfdb_adr%,12)}=15
      ELSE
        INT{ADD(mfdb_adr%,12)}=bitplane_number&
      ENDIF
      INT{ADD(mfdb_adr%,14)}=0
      INT{ADD(mfdb_adr%,16)}=0
      INT{ADD(mfdb_adr%,18)}=0
      '
      file_i&=0
      file_j&=0
      '
      dummy_size%=SHL&(MUL(INT{ADD(file_adr%,6)},INT{ADD(file_adr%,8)}),1)
      ADD file_adr%,20
      dummy_cale%=SUB(ADD(file_adr%,dummy_size%),2)
      ktrans%=LONG{mfdb_adr%}
      FOR itrans%=file_adr% TO dummy_cale% STEP 2
        '
        trns_0&=INT{itrans%}
        trns_1&=INT{ADD(itrans%,dummy_size%)}
        trns_2&=INT{ADD(itrans%,MUL(dummy_size%,2))}
        trns_3&=INT{ADD(itrans%,MUL(dummy_size%,3))}
        trns_4&=INT{ADD(itrans%,MUL(dummy_size%,4))}
        trns_5&=INT{ADD(itrans%,MUL(dummy_size%,5))}
        trns_6&=INT{ADD(itrans%,MUL(dummy_size%,6))}
        trns_7&=INT{ADD(itrans%,MUL(dummy_size%,7))}
        '
        FOR jtrans&=1 TO 16
          '
          trns_8&=SHR&(trns_0&,15)
          ADD trns_8&,SHL&(SHR&(trns_1&,15),1)
          ADD trns_8&,SHL&(SHR&(trns_2&,15),2)
          ADD trns_8&,SHL&(SHR&(trns_3&,15),3)
          ADD trns_8&,SHL&(SHR&(trns_4&,15),4)
          ADD trns_8&,SHL&(SHR&(trns_5&,15),5)
          ADD trns_8&,SHL&(SHR&(trns_6&,15),6)
          ADD trns_8&,SHL&(SHR&(trns_7&,15),7)
          '
          trns_0&=SHL&(trns_0&,1)
          trns_1&=SHL&(trns_1&,1)
          trns_2&=SHL&(trns_2&,1)
          trns_3&=SHL&(trns_3&,1)
          trns_4&=SHL&(trns_4&,1)
          trns_5&=SHL&(trns_5&,1)
          trns_6&=SHL&(trns_6&,1)
          trns_7&=SHL&(trns_7&,1)
          '
          snow_g&(MIN(file_j&,63),MIN(file_i&,63))=trans_pal|(trns_8&)
          INC file_j&
          IF file_j&>63
            INC file_i&
            file_j&=0
          ENDIF
          '
        NEXT jtrans&
      NEXT itrans%
      SUB file_adr%,20
      good!=TRUE
      '
      @mxfree(file_adr%)
    ENDIF
  ENDIF
  '
  RETURN good!
ENDFUNC
> FUNCTION load_dgx(pdgx_name$)
  $F%
  LOCAL dgx_handle&,dgx_len%,dgx_filename$,dgx_pos&
  ~FRE(0)
  dgx_ptr%=0
  '
  dgx_pos&=RINSTR(pdgx_name$,"\")
  dgx_filename$=LEFT$(pdgx_name$,PRED(dgx_pos&))+".DGX"
  dgi_filename$=MID$(pdgx_name$,SUCC(dgx_pos&))
  dgi_filename$=LEFT$(dgi_filename$,PRED(INSTR(dgi_filename$,".")))
  IF LEN(dgi_filename$)<8
    dgi_filename$=dgi_filename$+SPACE$(MAX(SUB(8,LEN(dgi_filename$))))
  ENDIF
  '
  IF EXIST(dgx_filename$)
    IF dgx_filename$=old_dgx_filename$
      dgx_ptr%=@search_into_dgx(dgi_filename$)
    ENDIF
    '
    IF dgx_ptr%=0
      '
      dgx_handle&=FOPEN(dgx_filename$,0)
      IF dgx_handle&>0
        dgx_len%=FSEEK(0,dgx_handle&,2)
        ~FSEEK(0,dgx_handle&,0)
        IF dgx_buffer_len%<SHL(SHR(ADD(dgx_len%,32),4),4)
          @mxfree(dgx_adr%)
          dgx_adr%=0
          dgx_buffer_len%=SHL(SHR(ADD(dgx_len%,32),4),4)
        ENDIF
        IF dgx_adr%<1
          dgx_adr%=@mxalloc(dgx_buffer_len%,3)
        ENDIF
        IF dgx_adr%>0
          ~FREAD(dgx_handle&,dgx_len%,dgx_adr%)
          '
          old_dgx_filename$=dgx_filename$
          dgx_ptr%=@search_into_dgx(dgi_filename$)
          '
        ENDIF
        ~FCLOSE(dgx_handle&)
      ENDIF
      '
    ENDIF
  ELSE
    '
    @mxfree(dgx_adr%)
    dgx_adr%=0
    '
    dgx_handle&=FOPEN(pdgx_name$,0)
    IF dgx_handle&>0
      dgx_len%=FSEEK(0,dgx_handle&,2)
      ~FSEEK(0,dgx_handle&,0)
      IF dgx_buffer_len%<SHL(SHR(ADD(dgx_len%,32),4),4)
        @mxfree(dgx_adr%)
        dgx_adr%=0
        dgx_buffer_len%=SHL(SHR(ADD(dgx_len%,32),4),4)
      ENDIF
      IF dgx_adr%<1
        dgx_adr%=@mxalloc(dgx_buffer_len%,3)
      ENDIF
      IF dgx_adr%>0
        ~FREAD(dgx_handle&,dgx_len%,dgx_adr%)
        '
        dgx_ptr%=dgx_adr%
        '
      ENDIF
      ~FCLOSE(dgx_handle&)
    ENDIF
  ENDIF
  '
  RETURN dgx_ptr%
ENDFUNC
> FUNCTION search_into_dgx(pdgi_name$)
  $F%
  LOCAL sdgx_ptr%,sdgx_name$,sdgx_len&,sdgx_cpt&
  sdgx_adr%=0
  sdgx_cpt&=0
  '
  IF dgx_adr%>0
    IF MKL$(LONG{dgx_adr%})="_DGX"
      sdgx_len&=INT{ADD(dgx_adr%,4)}
      IF sdgx_len&>0
        sdgx_ptr%=ADD(dgx_adr%,6)
        DO
          sdgx_name$=MKL$(LONG{sdgx_ptr%})+MKL$(LONG{ADD(sdgx_ptr%,4)})
          IF sdgx_name$=pdgi_name$
            sdgx_adr%=ADD(dgx_adr%,LONG{ADD(sdgx_ptr%,8)})
            sdgx_cpt&=sdgx_len&
          ENDIF
          INC sdgx_cpt&
          ADD sdgx_ptr%,12
        LOOP UNTIL sdgx_cpt&>=sdgx_len&
      ENDIF
    ENDIF
  ENDIF
  '
  RETURN sdgx_adr%
ENDFUNC
> PROCEDURE load_palette
  LOCAL filename_palette$,file_handle&
  '
  filename_palette$=application_path$+"PEARL.P08"
  '
  IF EXIST(filename_palette$) AND (palette_work%>0)
    file_handle&=FOPEN(filename_palette$,0)
    IF file_handle&>0
      ~FSEEK(12,file_handle&,0)
      ~FREAD(file_handle&,1536,palette_work%)
      ~FCLOSE(file_handle&)
    ENDIF
  ELSE
    ~FORM_ALERT(1,"[1][ Need PEARL.P08 file ][ Quit ]")
    leave
  ENDIF
  '
RETURN
'
> PROCEDURE main
  @create_win
  @set_values
  @v_hide_c
  @clear_win
  exit!=FALSE
  DO
    @draw_win
  LOOP UNTIL exit!
  @v_show_c
  @leave
RETURN
'
> PROCEDURE create_win
  hand_win&=WIND_CREATE(&X0,30,30,30,30)
  IF hand_win&>0
    wx&=_DX
    wy&=_DY
    wl&=_DW
    wh&=_DH
    win!=TRUE
    IF WIND_OPEN(hand_win&,wx&,wy&,wl&,wh&)=0
      ~FORM_ALERT(1,"[1][ Can't open window ][ Quit ]")
      @leave
    ELSE
      ~WIND_GET(hand_win&,4,xd&,yd&,ld&,hd&)
    ENDIF
  ELSE
    ~FORM_ALERT(1,"[1][ No window available ][ Quit ]")
    @leave
  ENDIF
  aff!=win!
RETURN
> PROCEDURE set_values
  '
  DIM snow_g&(64,64)
  '
  @save_colors
  @load_palette
  @load_images
  '
  IF univers_delay&<0
    univers_delay&=0
  ENDIF
  '
  center_x&=ADD(xd&,DIV(ld&,2))
  center_y&=ADD(yd&,DIV(hd&,2))
  '
  IF NOT univers_clipped!
    clear_x&=xd&
    clear_y&=yd&
    clear_w&=ld&
    clear_h&=hd&
  ELSE
    clear_zone&=400
    clear_x&=MAX(xd&,SUB(center_x&,DIV(clear_zone&,2)))
    clear_y&=MAX(yd&,SUB(center_y&,DIV(clear_zone&,2)))
    clear_w&=MIN(ld&,clear_zone&)
    clear_h&=MIN(hd&,clear_zone&)
  ENDIF
  '
  center_a&=DIV(clear_w&,2)
  center_b&=DIV(clear_h&,2)
  center_h&=clear_h&
  '
  IF univers_force_offscreen!
    @declare_offscreen(clear_w&,clear_h&)
    IF offscreen_enabled!
      '
      SET.SXYWH 0,0,clear_w&,clear_h&
      SET.DXYWH clear_x&,clear_y&,clear_w&,clear_h&
      '
    ENDIF
  ELSE
    off_handle&=-1
    offscreen_enabled!=FALSE
  ENDIF
  '
  @set_colors
  '
RETURN
> PROCEDURE close_win
  IF win!
    ~WIND_CLOSE(hand_win&)
    ~WIND_DELETE(hand_win&)
    win!=FALSE
    aff!=FALSE
  ENDIF
RETURN
> PROCEDURE clear_win
  V~H=-1
  ~VSF_COLOR(1)
  ~VS_CLIP(1,xd&,yd&,ADD(xd&,PRED(ld&)),ADD(yd&,PRED(hd&)))
  ~V_BAR(xd&,yd&,ADD(xd&,PRED(ld&)),ADD(yd&,PRED(hd&)))
  ~VS_CLIP(0,xd&,yd&,ADD(xd&,PRED(ld&)),ADD(yd&,PRED(hd&)))
RETURN
> PROCEDURE draw_win
  LOCAL snow_t,snow_w&,snow_l&,snow_p!,snow_a&,snow_b&
  '
  snow_t=0
  '
  snow_p!=(univers_pixel_size&=1)
  '
  IF univers_clipped!
    snow_w&=univers_pixel_size&
  ELSE
    snow_w&=ADD(univers_pixel_size&,4)
  ENDIF
  '
  '
  ~VS_CLIP(1,clear_x&,clear_y&,ADD(clear_x&,PRED(clear_w&)),ADD(clear_y&,PRED(clear_h&)))
  IF offscreen_enabled!
    V~H=off_handle&
    ~VS_CLIP(1,0,0,PRED(clear_w&),PRED(clear_h&))
    V~H=-1
  ENDIF
  '
  DO
    snow_t=snow_t+0.02
    '
    IF univers_delay&>0
      ~EVNT_TIMER(univers_delay&)
    ENDIF
    '
    IF offscreen_enabled!
      V~H=off_handle&
      ~VSF_COLOR(1)
      ~V_BAR(0,0,PRED(clear_w&),PRED(clear_h&))
      '
      FOR k&=0 TO 63
        '
        i&=(k&*SGN(SIN(snow_t))) AND &X111111
        snow_a=(31-i&)*COS(snow_t)
        snow_b=(31-i&)*SIN(snow_t)+60
        '
        FOR j&=0 TO 63
          snow_c&=snow_g&(i&,j&)
          IF snow_c&>0
            ~VSF_COLOR(snow_c&)
            snow_a&=ADD(center_a&,snow_a*center_h&/snow_b)
            snow_b&=ADD(center_b&,(j&-31)*center_h&/snow_b)
            snow_l&=MUL(snow_w&,64)/snow_b
            ~V_BAR(snow_a&,snow_b&,ADD(snow_a&,PRED(snow_l&)),ADD(snow_b&,PRED(snow_l&)))
          ENDIF
        NEXT j&
      NEXT k&
      V~H=-1
      ~VRO_CPYFM(3,off_mfdb%,scr_mfdb%)
    ELSE
      ~VSF_COLOR(1)
      ~V_BAR(clear_x&,clear_y&,ADD(clear_x&,PRED(clear_w&)),ADD(clear_y&,PRED(clear_h&)))
      '
      FOR k&=0 TO 63
        '
        i&=(k&*SGN(SIN(snow_t))) AND &X111111
        snow_a=(31-i&)*COS(snow_t)
        snow_b=(31-i&)*SIN(snow_t)+60
        '
        FOR j&=0 TO 63
          snow_c&=snow_g&(i&,j&)
          IF snow_c&>0
            ~VSF_COLOR(snow_c&)
            snow_a&=ADD(center_a&,snow_a*center_h&/snow_b)
            snow_b&=ADD(center_b&,(j&-31)*center_h&/snow_b)
            snow_l&=MUL(snow_w&,64)/snow_b
            ~V_BAR(snow_a&,snow_b&,ADD(snow_a&,PRED(snow_l&)),ADD(snow_b&,PRED(snow_l&)))
          ENDIF
        NEXT j&
      NEXT k&
    ENDIF
    '
    ~GRAF_MKSTATE(gm_x&,gm_y&,gm_s&,gk_s&)
    IF BCONSTAT(2) OR gm_s&>0 OR gk_s&>0
      exit!=TRUE
    ENDIF
  LOOP UNTIL exit!
  '
  ~VS_CLIP(0,clear_x&,clear_y&,ADD(clear_x&,PRED(clear_w&)),ADD(clear_y&,PRED(clear_h&)))
  IF offscreen_enabled!
    V~H=off_handle&
    ~VS_CLIP(0,0,0,PRED(clear_w&),PRED(clear_h&))
    V~H=-1
  ENDIF
  '
RETURN
'
> PROCEDURE restore_colors
  LOCAL tmp_c&,tmp_d&,col_r&,col_g&,col_b&
  '
  IF palette_save%>0
    FOR tmp_c&=0 TO 255
      tmp_d&=MUL(tmp_c&,6)
      col_r&=INT{ADD(palette_save%,tmp_d&)}
      col_g&=INT{ADD(palette_save%,ADD(tmp_d&,2))}
      col_b&=INT{ADD(palette_save%,ADD(tmp_d&,4))}
      ~VS_COLOR(tmp_c&,col_r&,col_g&,col_b&)
    NEXT tmp_c&
  ENDIF
RETURN
> PROCEDURE save_colors
  LOCAL tmp_c&,tmp_d&,col_r&,col_g&,col_b&
  '
  IF palette_save%>0
    FOR tmp_c&=0 TO 255
      ~VQ_COLOR(tmp_c&,0,col_r&,col_g&,col_b&)
      tmp_d&=MUL(tmp_c&,6)
      INT{ADD(palette_save%,tmp_d&)}=col_r&
      INT{ADD(palette_save%,ADD(tmp_d&,2))}=col_g&
      INT{ADD(palette_save%,ADD(tmp_d&,4))}=col_b&
    NEXT tmp_c&
  ENDIF
RETURN
> PROCEDURE set_colors
  LOCAL tmp_l&,tmp_c&
  '
  IF palette_work%>0
    FOR tmp_c&=16 TO 255
      tmp_d&=MUL(tmp_c&,6)
      col_r&=INT{ADD(palette_work%,tmp_d&)}
      col_g&=INT{ADD(palette_work%,ADD(tmp_d&,2))}
      col_b&=INT{ADD(palette_work%,ADD(tmp_d&,4))}
      ~VS_COLOR(tmp_c&,col_r&,col_g&,col_b&)
    NEXT tmp_c&
    '
    IF offscreen_enabled!
      V~H=off_handle&
      FOR tmp_c&=16 TO 255
        tmp_d&=MUL(tmp_c&,6)
        col_r&=INT{ADD(palette_work%,tmp_d&)}
        col_g&=INT{ADD(palette_work%,ADD(tmp_d&,2))}
        col_b&=INT{ADD(palette_work%,ADD(tmp_d&,4))}
        ~VS_COLOR(tmp_c&,col_r&,col_g&,col_b&)
      NEXT tmp_c&
      V~H=-1
    ENDIF
  ENDIF
RETURN
'
> PROCEDURE v_hide_c
  IF naes!
    GHIDEM
  ELSE
    ~V_HIDE_C()
  ENDIF
RETURN
> PROCEDURE v_show_c
  IF naes!
    GSHOWM
  ELSE
    ~V_SHOW_C()
  ENDIF
RETURN
'
> FUNCTION mx_mask
  $F%
  IF MXALLOC(-1,0)=-32
    RETURN 0
  ELSE IF SYSCONF(-1)=-32
    RETURN 3
  ELSE
    RETURN -1
  ENDIF
ENDFUNC
> FUNCTION mxalloc(mxlen%,mxmode&)
  $F%
  IF mxalloc!
    RETURN MXALLOC(mxlen%,mxmode&)
  ENDIF
  RETURN MALLOC(mxlen%)
ENDFUNC
> PROCEDURE mxfree(mx_adr%)
  IF mx_adr%>0
    ~MFREE(mx_adr%)
  ENDIF
RETURN