' ******************
' *** INITIO.LST ***
' ******************
'
DEFWRD "a-z"
'
> PROCEDURE coldstart
  ' *** cold (= hard) reset
  ' *** same as turning your computer off and on, but faster
  SLPOKE &H420,0
  SLPOKE &H426,0        ! probably not necessary
  SLPOKE &H43A,0
  ~XBIOS(38,L:LPEEK(4))
RETURN
' **********
'
> PROCEDURE warmstart
  ' *** warm (= soft) reset, probably only suitable after switching resolutions
  ' *** tables in low memory (< &H93A) are not cleared
  ' *** same as pressing Reset-button on your computer
  ~XBIOS(38,L:LPEEK(4))
RETURN
' **********
'
> PROCEDURE initio.system
  ' *** initialise global system-variables
  ' *** global : START.OS%  DISK.TOS!  NORMAL.ST!  MEGA.ST!  DRIVE!()  FLOPS
  ' ***        WRITE.PROTECTED!()  RAM.END%  RAM.520!  RAM.1M!  RAM.2M!  RAM.4M!
  ' ***        ST.512!  ST.1040!  HARD.DISK!  DRIVE  DRIVE$  FREE.BYTES%
  LOCAL d,n,st.type
  '
  start.os%=LPEEK(&H4F2)
  '
  IF PEEK(start.os%)<>&H60
    disk.tos!=TRUE
  ENDIF
  IF DPEEK(start.os%)=&H601E
    normal.st!=TRUE
  ELSE
    mega.st!=TRUE
  ENDIF
  '
  DIM drive!(16)             ! Drive!(1) = drive A, etc.
  SELECT DPEEK(&H4A6)        ! first check if two drives connected
  CASE 1
    drive!(1)=TRUE
  CASE 2
    drive!(1)=TRUE
    drive!(2)=TRUE
  ENDSELECT
  FOR n=2 TO 15
    IF BTST(BIOS(10),n)
      drive!(n+1)=TRUE
    ENDIF
  NEXT n
  '
  flops=PEEK(&H4A6)    ! number of floppy drives (0-2); RAM-disks not counted
  '
  DIM write.protected!(15)             ! (only checked for drive A)
  FOR n=0 TO 15
    IF drive!(n+1)
      IF normal.st!
        LET write.protected!(n)=(PEEK(&H9B2+n)=255)
      ELSE
        LET write.protected!(n)=(PEEK(&H9F8+n)=255)
      ENDIF
    ENDIF
  NEXT n
  '
  ram.end%=LPEEK(&H42E)-1
  IF ram.end%=&H7FFFF
    ram.520!=TRUE
  ENDIF
  IF ram.end%=&HFFFFF
    ram.1m!=TRUE
  ENDIF
  IF ram.end%=&H1FFFFF
    ram.2m!=TRUE
  ENDIF
  IF ram.end%=&H3FFFFF
    ram.4m!=TRUE
  ENDIF
  '
  st.type=PEEK(&H424)
  IF st.type=4
    st.512!=TRUE
  ENDIF
  IF st.type=5
    st.1040!=TRUE
  ENDIF
  '
  IF PEEK(&H472)<>0
    hard.disk!=TRUE
  ENDIF
  '
  drive=GEMDOS(&H19)
  drive$=CHR$(65+drive)
  '
  free.bytes%=FRE(0)
  '
RETURN
' **********
'
> PROCEDURE keyboard.version
  ' *** examines keyboard-version, returns country
  ' *** global :  USA.KEYBRD!  ENGLISH.KEYBRD!  GERMAN.KEYBRD!  FRENCH.KEYBRD!
  SELECT PEEK(LPEEK(XBIOS(16,L:-1,L:-1,L:-1))+&H2B)
  CASE &H5C
    usa.keybrd!=TRUE
  CASE &H23
    english.keybrd!=TRUE
  CASE &H7E
    german.keybrd!=TRUE
  CASE &H40
    french.keybrd!=TRUE
  ENDSELECT
RETURN
' **********
'
> PROCEDURE initio.cursor
  ' *** VT52 control codes (for TOS-screen, not to be used in a window !)
  ' *** see also DEFFN.LST
  cur.up$=CHR$(27)+"A"     ! cursor up
  cur.dwn$=CHR$(27)+"B"    ! cursor down
  cur.rgt$=CHR$(27)+"C"    ! cursor right
  cur.lft$=CHR$(27)+"D"    ! cursor left
  cur.home$=CHR$(27)+"H"   ! home cursor (1,1)
  scroll.dwn$=CHR$(27)+"I" ! scroll screen 1 line down
  cur.cls$=CHR$(27)+"J"    ! clear screen from position of cursor
  cls.cur$=CHR$(27)+"d"    ! clear screen to position of cursor
  cll$=CHR$(27)+"l"        ! clear line (cursor to start of cleared line)
  del.line$=CHR$(27)+"M"   ! delete line (add new line at bottom of screen)
  ins.line$=CHR$(27)+"L"   ! insert line
  cur.cll$=CHR$(27)+"K"    ! clear line from position of cursor
  cll.cur$=CHR$(27)+"o"    ! clear line to position of cursor
  cur.on$=CHR$(27)+"e"     ! cursor visible
  cur.off$=CHR$(27)+"f"    ! cursor invisible (still controllable)
  get.cur$=CHR$(27)+"j"    ! save cursor-position
  put.cur$=CHR$(27)+"k"    ! put cursor on saved position
  rev.on$=CHR$(27)+"p"     ! reverse on
  rev.off$=CHR$(27)+"q"    ! reverse off
  wrap.on$=CHR$(27)+"v"    ! wrap on
  wrap.off$=CHR$(27)+"w"   ! wrap off (chop off lines longer than screen-width)
RETURN
' **********
'
> PROCEDURE initio.ascii.code
  ' *** ASCII-codes
  '
  bel$=CHR$(7)
  lf$=CHR$(10)
  vt$=CHR$(11)
  ff$=CHR$(12)
  qt$=CHR$(34)
  '
  return$=CHR$(13)
  enter$=CHR$(13)
  esc$=CHR$(27)
  delete$=CHR$(127)
  backspace$=CHR$(8)
  bs$=CHR$(8)
  tab$=CHR$(9)
  '
  help$=CHR$(0)+CHR$(98)
  undo$=CHR$(0)+CHR$(97)
  insert$=CHR$(0)+CHR$(82)
  clr.home$=CHR$(0)+CHR$(71)
  arr.lft$=CHR$(0)+CHR$(75)
  arr.rgt$=CHR$(0)+CHR$(77)
  arr.up$=CHR$(0)+CHR$(72)
  arr.dwn$=CHR$(0)+CHR$(80)
  '
  ' function-keys : see DEFFN.LST
  '
RETURN
' **********
'
> PROCEDURE initio.sprite1
  ' *** make sprite Sprite1$ (use Initio.sprite2 with DATA for Sprite2$, etc.)
  ' *** global :  SPRITE1$
  ' *** uses Standard-Array color.index()
  '
  RESTORE pattern.sprite1
  @make.sprite(sprite1$)
  '
  pattern.sprite1:
  ' *** x,y,mode(0=normal;1=XOR),mask-color,sprite-color
  DATA 0,0,0,0,1
  ' *** mask-pattern (1 = pixel on , 0 = pixel off)
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  ' *** sprite-pattern
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
RETURN
' ***
> PROCEDURE make.sprite(VAR s$)
  ' *** construct sprite-string from DATA
  LOCAL x,y,mode,msk.color,spr.color,n,msk%,spr%,msk.pat$,spr.pat$
  LOCAL msk$,spr$,pat$
  CLR msk.pat$,spr.pat$,pat$
  READ x,y,mode,msk.color,spr.color
  FOR n=1 TO 16
    READ msk$
    msk%=VAL("&X"+msk$)
    msk.pat$=msk.pat$+MKI$(msk%)
  NEXT n
  FOR n=1 TO 16
    READ spr$
    spr%=VAL("&X"+spr$)
    spr.pat$=spr.pat$+MKI$(spr%)
  NEXT n
  FOR n=1 TO 16
    pat$=pat$+MID$(msk.pat$,n*2-1,2)+MID$(spr.pat$,n*2-1,2)
  NEXT n
  s$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color))
  s$=s$+MKI$(color.index(spr.color))+pat$
RETURN
' **********
'
> PROCEDURE initio.mouse1
  ' *** make mouse-cursor Mouse1$ (use Initio.mouse2 with DATA for Mouse2$,etc.)
  ' *** uses Standard-Array color.index()
  ' *** global :  MOUSE1$
  '
  RESTORE pattern.mouse1
  @make.mouse(mouse1$)
  '
  pattern.mouse1:
  ' *** x,y,mode(0=normal;1=XOR),mask-color,mouse-color
  DATA 0,0,0,0,1
  ' *** mask-pattern (1 = pixel on , 0 = pixel off)
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  ' *** mouse-pattern
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
RETURN
' ***
> PROCEDURE make.mouse(VAR m$)
  ' *** construct mouse-string from DATA
  LOCAL x,y,mode,msk.color,mouse.color,n,msk%,mouse%,msk.pat$,mouse.pat$
  LOCAL msk$,mouse$,pat$
  CLR msk.pat$,mouse.pat$,pat$
  READ x,y,mode,msk.color,mouse.color
  FOR n=1 TO 16
    READ msk$
    msk%=VAL("&X"+msk$)
    msk.pat$=msk.pat$+MKI$(msk%)
  NEXT n
  FOR n=1 TO 16
    READ mouse$
    LET mouse%=VAL("&X"+mouse$)
    LET mouse.pat$=mouse.pat$+MKI$(mouse%)
  NEXT n
  m$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color))
  m$=m$+MKI$(color.index(mouse.color))+msk.pat$+mouse.pat$
RETURN
' **********
'
> PROCEDURE initio.mouse
  ' *** mouse-cursor
  arrow.mouse=0
  x.mouse=1
  bee.mouse=2
  finger.mouse=3
  hand.mouse=4
  thin.cross.mouse=5
  fat.cross.mouse=6
  LET open.cross.mouse=7
  l.button=1                ! mouse-buttons
  r.button=2
  both.buttons=3
  no.button=0
RETURN
' **********
'
> PROCEDURE initio.fill1(VAR pattern$)
  ' *** FILL-pattern for High (32 bytes), Medium (64) or Low (128) resolution
  LOCAL bytes
  bytes=32         ! 32 bytes for High resolution
  '
  ' *** load Fill-pattern (32 bytes for High resolution) here
  INLINE fill1%,32
  '
  pattern$=STRING$(bytes,0)
  BMOVE fill1%,V:pattern$,bytes
  DEFFILL ,pattern$
RETURN
' **********
'
> PROCEDURE initio.high.fill1
  ' *** fill-pattern for High-resolution (also suitable for Medium and Low)
  ' *** patterns always have a format of 16x16 pixels
  ' *** global :  FILL1$
  '
  RESTORE high.fill1
  @make.high.fill(fill1$)
  '
  high.fill1:
  ' *** use index 0 or 1 (0=background) ; switch editor to Overwrite-mode
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
RETURN
' ***
> PROCEDURE make.high.fill(VAR fill$)
  LOCAL i,pat$,pat%
  CLR fill$
  FOR i=1 TO 16
    READ pat$
    pat%=VAL("&X"+pat$)
    fill$=fill$+MKI$(pat%)
  NEXT i
RETURN
' **********
'
> PROCEDURE initio.med.fill1
  ' *** fill-pattern for Medium resolution (also suitable for Low resolution)
  ' *** global :  FILL1$
  '
  RESTORE med.fill1
  @make.med.fill(fill1$)
  '
  med.fill1:
  ' *** use index 0-3 (0=background-color) ; switch editor to Overwrite-mode
  ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!)
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
RETURN
' ***
> PROCEDURE make.med.fill(VAR fill$)
  LOCAL i,j,pat$,plane0%,plane1%,plane0$,plane1$
  CLR fill$,plane0$,plane1$
  FOR i=1 TO 16
    READ pat$
    CLR plane0%,plane1%
    FOR j=1 TO 16
      SELECT VAL(MID$(pat$,j,1))
      CASE 1
        plane0%=BSET(plane0%,SUB(16,j))
      CASE 2
        plane1%=BSET(plane1%,SUB(16,j))
      CASE 3
        plane0%=BSET(plane0%,SUB(16,j))
        plane1%=BSET(plane1%,SUB(16,j))
      ENDSELECT
    NEXT j
    plane0$=plane0$+MKI$(plane0%)
    plane1$=plane1$+MKI$(plane1%)
  NEXT i
  fill$=plane0$+plane1$
RETURN
' **********
'
> PROCEDURE initio.low.fill1
  ' *** fill-pattern for Low resolution only
  ' *** global :  FILL1$
  '
  RESTORE low.fill1
  @make.low.fill(fill1$)
  '
  low.fill1:
  ' *** use index 0-F (0=background-color) ; switch editor to Overwrite-mode
  ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!)
  ' *** 0-F means you can use : 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F (16 colors)
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
  DATA 0000000000000000
RETURN
' ***
> PROCEDURE make.low.fill(VAR fill$)
  LOCAL i,j,pat$,plane0%,plane1%,plane2%,plane3%,byte|
  LOCAL plane0$,plane1$,plane2$,plane3$
  CLR fill$,plane0$,plane1$,plane2$,plane3$
  FOR i=1 TO 16
    READ pat$
    CLR plane0%,plane1%,plane2%,plane3%
    FOR j=1 TO 16
      byte|=VAL("&H"+MID$(pat$,j,1))
      IF BTST(byte|,0)
        plane0%=BSET(plane0%,SUB(16,j))
      ENDIF
      IF BTST(byte|,1)
        plane1%=BSET(plane1%,SUB(16,j))
      ENDIF
      IF BTST(byte|,2)
        plane2%=BSET(plane2%,SUB(16,j))
      ENDIF
      IF BTST(byte|,3)
        plane3%=BSET(plane3%,SUB(16,j))
      ENDIF
    NEXT j
    plane0$=plane0$+MKI$(plane0%)
    plane1$=plane1$+MKI$(plane1%)
    plane2$=plane2$+MKI$(plane2%)
    plane3$=plane3$+MKI$(plane3%)
  NEXT i
  fill$=plane0$+plane1$+plane2$+plane3$
RETURN
' **********
'
> PROCEDURE initio.pattern
  ' *** fill-pattterns
  hollow.fill=0
  solid.fill=1
  pattern.fill=2
  hatch.fill=3
RETURN
' **********
'
> PROCEDURE initio.line
  ' *** start/end of lines ; lines
  normal.line.end=0
  arrow.line.end=1
  rounded.line.end=2
  ' ***
  normal.line=1
  dash.line=2
  point.line=3
RETURN
' **********
'
> PROCEDURE initio.mark
  ' *** mark-symbols
  point.mark=1
  plus.mark=2
  star.mark=3
  rectangle.mark=4
  cross.mark=5
  diamond.mark=6
RETURN
' **********
'
> PROCEDURE initio.txt
  ' *** text-stiles ; text-rotation
  txt.normal=0
  txt.bold=1
  txt.light=2
  txt.ital=4
  txt.uline=8
  txt.outline=16
  ' ***
  txt.0=0
  txt.90=900
  txt.180=1800
  txt.270=2700
RETURN
' **********
'
> PROCEDURE initio.graph
  ' *** GRAPHMODE-modes
  graph.replace=1
  graph.transp=2
  graph.xor=3
  graph.rev.tr=4
RETURN
' **********
'
> PROCEDURE initio.alert
  ' *** Alert-symbols
  empty.alert=0
  note.alert=1
  wait.alert=2
  stop.alert=3
RETURN
' **********
'