' BIGPIC.LST
' Write programs for all resolutions
' ----------------------------------
' Reserve memory space for program
RESERVE 100000
'
' Initialise the resolution
' Determine resolution
resol%=XBIOS(4)
' Maximum cursor column
x_cursor%=INT{L~A-44}+1
' Maximum cursor row
y_cursor%=INT{L~A-42}+1
' Horizontal resolution
x_dim%=INT{L~A-12}
' Factor for X
xt=x_dim%/640
' Vertical resolution
y_dim%=INT{L~A-4}
' Factor for Y
yt=y_dim%/400
' Number of bit planes
bit_pl%=INT{L~A}
' Character width
x_char%=INT{L~A+80}
' Character height
y_char%=INT{L~A+82}
' Pixel width in micrometer
x_mue%=WORK_OUT(3)
' Pixel height in micrometer
y_mue%=WORK_OUT(4)
' Number of displayable colours
colours%=WORK_OUT(13)
' Number of available colours
col_total%=WORK_OUT(39)
'
'
DIM menu$(50),s%(8),d%(8),p%(8)
'
' simulate a different resolution   !sim
' 0= no simulation                  !sim
' 1= low resolution with SC1224     !sim
' 2= medium resolution with SC1224  !sim
' 3= high resolution with SM124     !sim
' 4= high resolution with MatScreen/M110  !sim
'
simulation%=0                      !sim
IF simulation%>0                   !sim
  @resol_simulation                !sim
  BOX 0,0,x_dim%,y_dim%            !sim
  BOX 0,0,x_dim%,y_dim%*2          !sim
  LINE x_dim%/2,0,x_dim%/2,y_dim%  !sim
ENDIF                              !sim
'
' Reserve UNDO space for screen
h%=x_dim%*y_dim%/8*bit_pl%
pict_addr%=MALLOC(-1)
IF pict_addr%>=h%
  pict_addr%=MALLOC(h%)
ELSE
  ALERT 1,"|Insufficient|memory space.",1," END ",d%
  EDIT
ENDIF
'
FOR i=0 TO 50
  READ menu$(i)
  @menu_simulation     !sim
  EXIT IF menu$(i)="***"
NEXT i
'
menu$(i)=""
menu$(i+1)=""
'
DATA Desk, Info,------------------------
DATA 1,2,3,4,5,6,""
DATA File,-Load,-Save,-----------, END,""
DATA Others, 1 Fileselect , 2 32034 load , 3 SGET SPUT
DATA  4 Erase pic , 5 Erase Sp. , 6 Erase part , 7 Variable
DATA  8 Centre , 9 Print , 10, 11, 12
DATA  13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,""
DATA ***
'
MENU menu$()
'
ON MENU GOSUB menu
'
DO
  ON MENU
LOOP
'
PROCEDURE menu
  MENU OFF
  IF simulation%>0                             !sim
    PRINT AT(1,y_cursor%-1);menu$(MENU(0))'MENU(0),  !sim
  ENDIF
  SELECT MENU(0)
  CASE 1
    @info
  CASE 14
    @end
  CASE 17
    @fileselect
  CASE 18
    @degas
  CASE 19
    @sget_sput
  CASE 20
    @pict_erase
  CASE 21
    @sp_erase
  CASE 22
    @part_erase
  CASE 23
    @variable
  CASE 24
    @centre
  CASE 25
    @print
  ENDSELECT
  MENU menu$()
RETURN
'
PROCEDURE info
  ALERT 1,"|This program runs in |ALL resolutions! ",1," OK ",d%
RETURN
'
PROCEDURE end
  ALERT 2,"|End program?",1,"Yes|No",d%
  IF d%=1
    MENU KILL
    ' Release UNDO space
    VOID MFREE(pict_addr%)
    EDIT
  ENDIF
RETURN
'
PROCEDURE menu_simulation          !sim
  INC e%
  l%=LEN(menu$(i))
  IF l%=0
    area%=(e%-2)*ll%
    IF e%>25
      ALERT 3,"|The menu "+STR$(m%)+" has|more than 23 entries!",1,"OK",d%
    ENDIF
    IF area%>361
      ALERT 3,"|The menu "+STR$(m%)+" is too|large for low resolution!",1,"OK",d%
    ENDIF
    INC m%
    CLR ll%,e%
  ENDIF
  ll%=MAX(ll%,l%)
RETURN
'
PROCEDURE resol_simulation         !sim
  ' simulate a different resolution !sim
  ' 1= low resolution with SC1224   !sim
  ' 2= medium resolution with SC1224!sim
  ' 3= high resolution with SM124   !sim
  ' 4= high resolution with MatScreen/M110  !sim
  SELECT simulation%
  CASE 1
    resol%=0
    x_cursor%=40
    y_cursor%=25
    x_dim%=320
    xt=0.5
    y_dim%=200
    yt=0.5
    bit_pl%=4
    x_char%=8
    y_char%=8
    x_mue%=372
    y_mue%=338
    colours%=16
    col_total%=512
  CASE 2
    resol%=1
    x_cursor%=80
    y_cursor%=25
    x_dim%=640
    xt=1
    y_dim%=200
    yt=0.5
    bit_pl%=2
    x_char%=8
    y_char%=8
    x_mue%=372
    y_mue%=169
    colours%=4
    col_total%=512
  CASE 3
    resol%=2
    x_cursor%=80
    y_cursor%=25
    x_dim%=640
    xt=1
    y_dim%=400
    yt=1
    bit_pl%=1
    x_char%=8
    y_char%=16
    x_mue%=372
    y_mue%=372
    colours%=2
    col_total%=2
  CASE 4
    resol%=2
    x_cursor%=160
    y_cursor%=60
    x_dim%=1280
    xt=2
    y_dim%=960
    yt=2.4
    bit_pl%=1
    x_char%=8
    y_char%=16
    x_mue%=372
    y_mue%=372
    colours%=2
    col_total%=2
  ENDSELECT
  VTAB 3
  PRINT " Resolution",,resol%
  PRINT " Maximum cursor column",x_cursor%
  PRINT " Maximum cursor row",y_cursor%
  PRINT " Horizontal resolution",x_dim%
  PRINT " Factor for X",,xt
  PRINT " Vertical resolution",y_dim%
  PRINT " Factor for Y",,yt
  PRINT " Number of bit planes";bit_pl%
  PRINT " Character width",x_char%
  PRINT " Character height",y_char%
  PRINT " Pixel width in micrometer",x_mue%
  PRINT " Pixel height in micrometer",y_mue%
  PRINT " Number of displayable colours",colours%
  PRINT " Number of available colours",col_total%
RETURN
'
PROCEDURE fileselect
  ' determine version number of TOS
  ' TOS 1.09/1.2: 4864, TOS 1.4: 6376 (?)
  title$="FILESELECT DEMO"
  IF GEMDOS(48)=4864
    GET 0,0,x_dim%-1,y_char%+2,help$
    PUT 0,0,help$,0
    LINE 0,y_char%+2,x_dim%-1,y_char%+2
    '
    ' PRINT AT(X,Y) Simulation                              !sim
    @print_at(x_cursor%/2-len(title%)/2+1,1,title$,resol%) !sim
    ' PRINT AT(x_cursor%/2-LEN(title$)/2+1,1);title$        !sim
    FILESELECT #title$,"\*.*","",file$
    PUT 0,0,help$
  ELSE
    FILESELECT #title$,"\*.*","",file$
  ENDIF
RETURN
'
PROCEDURE print_at(x%,y%,text$,xbios_4%)                   !sim
  ' Simulation of the PRINT AT command
  GRAPHMODE 2
  IF xbios_4%=2
    DEFTEXT 1,0,0,13
    TEXT x%*x_char%-x_char%,y%*y_char%-3,text$             !HR
  ELSE
    DEFTEXT 1,0,0,6
    TEXT x%*x_char%-x_char%,y%*y_char%-2,text$             !MR,LR
  ENDIF
RETURN
'
PROCEDURE degas
  ' Load Degas picture and display on screen
  ' A perfect simulation of the screen display in the wrong
  ' resolution is too complicated. But it works!
  ' See also the chapter on "loading files"
  h$=SPACE$(32034)
  h%=V:h$
  BLOAD "a:\KARIN.PI3",h%
  ' display only when picture has correct resolution
  IF resol%=CARD{h%}
    ' Move picture
    @bitblt_sd(h%+34,640,400,1,pict_addr%,x_dim%,y_dim%)
    @bitblt_p(0,0,639,399,0,0,3)
    '
    @bitblt_sd(pict_addr%,x_dim%,y_dim%,1,XBIOS(2),x_dim%,y_dim%)
    @bitblt_p(0,0,x_dim%-1,y_dim%-1,0,0,3)
  ELSE
    ALERT 1,"|The picture has  the |wrong resolution!",1,"OK ",d%
  ENDIF
RETURN
'
PROCEDURE sget_sput
  '
  ' Save screen contents (simulate SGET)
  @bitblt_sd(XBIOS(2),x_dim%,y_dim%,1,pict_addr%,x_dim%,y_dim%)
  @bitblt_p(0,0,x_dim%-1,y_dim%-1,0,0,3)
  '
  ' to test, modify a screen section
  DEFFILL 1,2,16
  PBOX 50,50,150,150
  VOID INP(2)
  '
  ' Restore screen contents (simulate SPUT)
  @bitblt_sd(pict_addr%,x_dim%,y_dim%,1,XBIOS(2),x_dim%,y_dim%)
  @bitblt_p(0,0,x_dim%-1,y_dim-1,0,0,3)
RETURN
'
PROCEDURE pict_erase
  CLS
RETURN
'
PROCEDURE sp_erase
  ' Mode p%(8)=0 means erase
  @bitblt_sd(pict_addr%,x_dim%,y_dim%,1,XBIOS(2),x_dim%,y_dim%)
  @bitblt_p(0,0,x_dim%-1,y_dim%-1,0,0,0)
RETURN
'
PROCEDURE part_erase
  ' Display picture
  @bitblt_sd(pict_addr%,x_dim%,y_dim%,1,XBIOS(2),x_dim%,y_dim%)
  @bitblt_p(0,0,x_dim%-1,y_dim%-1,0,0,3)
  '
  ' erase part of picture
  DEFFILL 1,0
  BOUNDARY 0
  PBOX 160,50,260,150
  '
  ' save erased picture
  @bitblt_sd(XBIOS(2),x_dim%,y_dim%,1,pict_addr%,x_dim%,y_dim%)
  @bitblt_p(0,0,x_dim%-1,y_dim%-1,0,0,3)
RETURN
'
PROCEDURE variable
  FOR m%=10 TO 40 STEP 10
    BOX m%*xt,m%*yt,x_dim%-m%*xt,y_dim%-m%*yt
  NEXT m%
RETURN
'
PROCEDURE centre
  ' fixed sized, centred in all resolutions
  w%=200
  h%=100
  DEFFILL 1,0
  BOUNDARY 1
  PBOX (x_dim%-w%)/2,(y_dim%-h%)/2,(x_dim%-w%)/2+w%,(y_dim%-h%)/2+h%
  BOX (x_dim%-w%)/2+2,(y_dim%-h%)/2+2,(x_dim%-w%)/2+w%-2,(y_dim%-h%)/2+h%-2
  BOX (x_dim%-w%)/2+3,(y_dim%-h%)/2+3,(x_dim%-w%)/2+w%-3,(y_dim%-h%)/2+h%-3
RETURN
'
PROCEDURE print
  z%=0
  CLS
  VTAB 3
  REPEAT
    FOR x%=5 TO x_cursor% STEP 10
      INC z%
      PRINT TAB(x%);z%
    NEXT x%
    PRINT
    IF CRSLIN=y_cursor%-2
      PRINT
      PRINT "  -MORE-  "
      LINE x_dim%,0,x_dim%,y_dim%       !sim
      VOID INP(2)
      CLS
      VTAB 3
    ENDIF
  UNTIL z%>=400
RETURN
'
PROCEDURE bitblt_sd(s0%,s1%,s2%,s5%,d0%,d1%,d2%)
  s%(0)=s0%
  s%(1)=s1%
  s%(2)=s2%
  s%(3)=s1%/16
  s%(5)=s5%
  d%(0)=d0%
  d%(1)=d1%
  d%(2)=d2%
  d%(3)=d1%/16
  d%(5)=s5%
RETURN
'
PROCEDURE bitblt_p(p0%,p1%,p2%,p3%,p4%,p5%,p8%)
  p%(0)=p0%
  p%(1)=p1%
  p%(2)=p0%+p2%
  p%(3)=p1%+p3%
  p%(4)=p4%
  p%(5)=p5%
  p%(6)=p4%+p2%
  p%(7)=p5%+p3%
  p%(8)=p8%
  BITBLT s%(),d%(),p%()
RETURN