' Beispiel f�r das Lesen und Schreiben von Dateien im IconEdi-format
'
' IconEdi (c) 1991 by Stefan M�nch
'
' Achtung : dies ist nur ein Beispiel ! Es finden (fast) keine Fehler�berpr�fungen statt !!
' Daher:
ON ERROR GOSUB ende
'
' Benutzte Variablen:
'
' Strings:
LET file$=""
' Long Integers:
LET length%=0
LET length.of.data%=0
LET address%=0
LET address2%=0
LET objectblock.address%=0
LET object.type%=0
LET iconblock.address%=0
LET mask.address%=0
LET data.address%=0
LET text.address%=0
LET bitblock.address%=0
LET image.address%=0
LET width%=0
LET height%=0
'
RESERVE 10000                           ! reduziert den von GFA-Basic benutzten Speicher,
'                                         so daž man Speicher mit MALLOC() anfordern kann
'
file$="demoicon.ico"                     ! Der Name der Icondatei
' file$="demoimag.ico"                     ! Der Name der Imagedatei
'
' ########################################################################################
' ##                                      Lesen                                         ##
' ########################################################################################
'
OPEN "i",#1,file$                       ! Dateil„nge bestimmen
LET length%=LOF(#1)
CLOSE #1
'
LET address%=MALLOC(length%)            ! Speicher allozieren
'
BLOAD file$,address%                    ! l„dt die Datei an die Adresse address%
'
IF LONG{address%}=&H49434F4E            ! $ 49 43 4F 4E ="ICON" (IconEdi-Format...trara !!)
  '
  '  Die Definition:
  '  $00    char icon_magic[4];    /* enth„lt "ICON"; $49434F4E */
  '  $04    int icon_version;      /* Versionsnummer, wie beim TOS; Start bei
  '                                   $0000 (=so wie hier vorgestellt) */
  '  $06    int icon_headerlength; /* L„nge des Headers in Words, Standard : 6 */
  '  $08    int *objectblock;      /* Zeiger auf den Objektblock */
  '
  LET objectblock.address%=LONG{address%+8}+address%
  '
  LET object.type%=WORD{objectblock.address%+6}
  '
  IF object.type%=31                ! Icon
    '
    LET iconblock.address%=LONG{objectblock.address%+12}+address%
    '
    LET mask.address%=LONG{iconblock.address%}+address%
    LET data.address%=LONG{iconblock.address%+4}+address%
    LET text.address%=LONG{iconblock.address%+8}+address%
    '
    LET width%=WORD{iconblock.address%+22}
    LET height%=WORD{iconblock.address%+24}
    '
    PRINT "Die Datei enth„lt ein Icon."
    PRINT
    PRINT "Der Objektblock liegt an Adresse ";objectblock.address%
    PRINT "Der Iconblock liegt an Adresse ";iconblock.address%
    PRINT
    PRINT "Die Maske liegt an Adresse ";mask.address%
    PRINT "Die Daten liegen an Adresse ";data.address%
    PRINT "Der Text liegt an Adresse ";text.address%
    PRINT
    PRINT "Breite: ";width%
    PRINT "H”he: ";height%
    '
  ELSE IF object.type%=23                ! Image
    '
    LET bitblock.address%=LONG{objectblock.address%+12}+address%
    '
    LET image.address%=LONG{bitblock.address%}+address%
    '
    LET width%=WORD{bitblock.address%+4}*8
    LET height%=WORD{bitblock.address%+6}
    '
    PRINT "Die Datei enth„lt ein Image."
    PRINT
    PRINT "Der Objektblock liegt an Adresse ";objectblock.address%
    PRINT "Der Bitblock liegt an Adresse ";bitblock.address%
    PRINT
    PRINT "Das Image liegt an Adresse ";image.address%
    PRINT
    PRINT "Breite: ";width%
    PRINT "H”he: ";height%
    '
  ELSE
    PRINT "Die Datei ist im IconEdi-Format, enth„lt aber weder Icon noch Image !!"
  ENDIF
  '
ELSE
  '
  PRINT "Kein IconEdi-Format !!"
  '
  GOSUB ende
  '
ENDIF
'
' ########################################################################################
' ##                                    Schreiben                                       ##
' ########################################################################################
'
'  Die Definition:
'  $00    char icon_magic[4];    /* enth„lt "ICON"; $49434F4E */
'  $04    int icon_version;      /* Versionsnummer, wie beim TOS; Start bei
'                                     $0000 (=so wie hier vorgestellt) */
'  $06    int icon_headerlength; /* L„nge des Headers in Words, Standard : 6 */
'  $08    int *objectblock;      /* Zeiger auf den Objektblock */
'
' Pufferl„nge bestimmen:
'
LET length.of.data%=DIV(width%,8)*height%   ! L„nge der Daten (Maske bzw. Daten bzw. Image)
'                                                                                 in Bytes
IF object.type%=31                      ! Icon
  LET length%=12+24+36+(length.of.data%*2)+(LEN(CHAR{text.address%})+1)
  '           12: Header IconEdi-Format
  '              24: Objektblock
  '                 36: Iconblock
  '                    (length.of.data%*2): L„nge der Daten und Maske (in Bytes)
  '                                        (LEN......+1): L„nge des Textes inkl. Nullbyte
ELSE
  LET length%=12+24+14+length.of.data%
  '           12: Header IconEdi-Format
  '              24: Objektblock
  '                 14: Bitblock
  '                    length.of.data%: L„nge des Images (in Bytes)
ENDIF
'
address2%=MALLOC(length%)                ! Speicher allozieren
'
' Header setzen:
LONG{address2%}=&H49434F4E               ! "ICON"
WORD{address2%+4}=0                      ! icon_version
WORD{address2%+6}=6                      ! icon_headerlength
LONG{address2%+8}=12                     ! *objectblock
'
IF object.type%=31                       ! Icon
  '
  ' Objektblock setzen:
  BMOVE objectblock.address%,address2%+12,22   ! erstmal den alten kopieren und ...
  ' ... dann die n”tigen Werte „ndern:
  WORD{address2%+12}=0                   ! ob_next
  WORD{address2%+14}=65535               ! ob_head
  WORD{address2%+16}=65535               ! ob_tail
  WORD{address2%+18}=31                  ! ob_type
  ' ob_flags bleiben unver„ndert
  ' ob_state bleibt unver„ndert
  LONG{address2%+24}=36                  ! ob_spec
  ' ob_x bleibt unver„ndert
  ' ob_y bleibt unver„ndert
  ' ob_width bleibt unver„ndert
  ' ob_height bleibt unver„ndert
  '
  ' Iconblock setzen:
  BMOVE iconblock.address%,address2%+36,36     ! erstmal den alten kopieren und ...
  ' ... dann die n”tigen Werte „ndern:
  LONG{address2%+36}=72                      ! ib_pmask
  LONG{address2%+40}=72+length.of.data%      ! ib_pdata
  LONG{address2%+44}=72+2*length.of.data%    ! ib_ptext
  ' char bleibt unver„ndert
  ' xchar bleibt unver„ndert
  ' ychar bleibt unver„ndert
  ' xicon bleibt unver„ndert
  ' yicon bleibt unver„ndert
  ' wicon bleibt unver„ndert
  ' hicon bleibt unver„ndert
  ' xtext bleibt unver„ndert
  ' ytext bleibt unver„ndert
  WORD{address2%+66}=6*LEN(CHAR{text.address%})  ! ib_wtext
  WORD{address2%+68}=8                           ! ib_htext
  WORD{address2%+70}=0                           ! ib_rsvd
  '
  ' Maske kopieren:
  BMOVE mask.address%,address2%+72,length.of.data%
  ' Daten kopieren:
  BMOVE data.address%,address2%+72+length.of.data%,length.of.data%
  ' Text kopieren:
  CHAR{address2%+72+2*length.of.data%}=CHAR{text.address%}
  '
ELSE IF object.type%=23                   ! Image
  '
  ' Objektblock setzen:
  BMOVE objectblock.address%,address2%+12,22   ! erstmal den alten kopieren und ...
  ' ... dann die n”tigen Werte „ndern:
  WORD{address2%+12}=0                   ! ob_next
  WORD{address2%+14}=65535               ! ob_head
  WORD{address2%+16}=65535               ! ob_tail
  WORD{address2%+18}=23                  ! ob_type
  ' ob_flags bleiben unver„ndert
  ' ob_state bleibt unver„ndert
  LONG{address2%+24}=36                  ! ob_spec
  ' ob_x bleibt unver„ndert
  ' ob_y bleibt unver„ndert
  ' ob_width bleibt unver„ndert
  ' ob_height bleibt unver„ndert
  '
  ' Bitblock setzen:
  BMOVE bitblock.address%,address2%+36,14   ! erstmal den alten kopieren und ...
  ' ... dann die n”tigen Werte „ndern:
  LONG{address2%+36}=50                     ! bi_pdata
  WORD{address2%+40}=DIV(width%,8)          ! Breite in Bytes
  WORD{address2%+42}=height%                ! H”he in Pixeln
  ' bi_x bleibt unver„ndert
  ' bi_y bleibt unver„ndert
  ' bi_color bleibt unver„ndert
  '
  ' Image kopieren:
  BMOVE image.address%,address2%+50,length.of.data%
  '
ENDIF
'
BSAVE file$,address2%,length%
'
GOSUB ende
'
PROCEDURE ende
  IF address2%>0
    VOID MFREE(address2%)
  ENDIF
  IF address%>0
    VOID MFREE(address%)
  ENDIF
  '
  RESERVE
  '
  END
  '
RETURN