home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0400 / CCE_0435.ZIP / CCE_0435.PD / ICONEDI / ZUBEHOER / DEMO / DEMO.LST next >
File List  |  1992-11-27  |  9KB  |  244 lines
  1. ' Beispiel für das Lesen und Schreiben von Dateien im IconEdi-format
  2. '
  3. ' IconEdi (c) 1991 by Stefan Münch
  4. '
  5. ' Achtung : dies ist nur ein Beispiel ! Es finden (fast) keine Fehlerüberprüfungen statt !!
  6. ' Daher:
  7. ON ERROR GOSUB ende
  8. '
  9. ' Benutzte Variablen:
  10. '
  11. ' Strings:
  12. LET file$=""
  13. ' Long Integers:
  14. LET length%=0
  15. LET length.of.data%=0
  16. LET address%=0
  17. LET address2%=0
  18. LET objectblock.address%=0
  19. LET object.type%=0
  20. LET iconblock.address%=0
  21. LET mask.address%=0
  22. LET data.address%=0
  23. LET text.address%=0
  24. LET bitblock.address%=0
  25. LET image.address%=0
  26. LET width%=0
  27. LET height%=0
  28. '
  29. RESERVE 10000                           ! reduziert den von GFA-Basic benutzten Speicher,
  30. '                                         so daß man Speicher mit MALLOC() anfordern kann
  31. '
  32. file$="demoicon.ico"                     ! Der Name der Icondatei
  33. ' file$="demoimag.ico"                     ! Der Name der Imagedatei
  34. '
  35. ' ########################################################################################
  36. ' ##                                      Lesen                                         ##
  37. ' ########################################################################################
  38. '
  39. OPEN "i",#1,file$                       ! Dateilänge bestimmen
  40. LET length%=LOF(#1)
  41. CLOSE #1
  42. '
  43. LET address%=MALLOC(length%)            ! Speicher allozieren
  44. '
  45. BLOAD file$,address%                    ! lädt die Datei an die Adresse address%
  46. '
  47. IF LONG{address%}=&H49434F4E            ! $ 49 43 4F 4E ="ICON" (IconEdi-Format...trara !!)
  48.   '
  49.   '  Die Definition:
  50.   '  $00    char icon_magic[4];    /* enthält "ICON"; $49434F4E */
  51.   '  $04    int icon_version;      /* Versionsnummer, wie beim TOS; Start bei
  52.   '                                   $0000 (=so wie hier vorgestellt) */
  53.   '  $06    int icon_headerlength; /* Länge des Headers in Words, Standard : 6 */
  54.   '  $08    int *objectblock;      /* Zeiger auf den Objektblock */
  55.   '
  56.   LET objectblock.address%=LONG{address%+8}+address%
  57.   '
  58.   LET object.type%=WORD{objectblock.address%+6}
  59.   '
  60.   IF object.type%=31                ! Icon
  61.     '
  62.     LET iconblock.address%=LONG{objectblock.address%+12}+address%
  63.     '
  64.     LET mask.address%=LONG{iconblock.address%}+address%
  65.     LET data.address%=LONG{iconblock.address%+4}+address%
  66.     LET text.address%=LONG{iconblock.address%+8}+address%
  67.     '
  68.     LET width%=WORD{iconblock.address%+22}
  69.     LET height%=WORD{iconblock.address%+24}
  70.     '
  71.     PRINT "Die Datei enthält ein Icon."
  72.     PRINT
  73.     PRINT "Der Objektblock liegt an Adresse ";objectblock.address%
  74.     PRINT "Der Iconblock liegt an Adresse ";iconblock.address%
  75.     PRINT
  76.     PRINT "Die Maske liegt an Adresse ";mask.address%
  77.     PRINT "Die Daten liegen an Adresse ";data.address%
  78.     PRINT "Der Text liegt an Adresse ";text.address%
  79.     PRINT
  80.     PRINT "Breite: ";width%
  81.     PRINT "Höhe: ";height%
  82.     '
  83.   ELSE IF object.type%=23                ! Image
  84.     '
  85.     LET bitblock.address%=LONG{objectblock.address%+12}+address%
  86.     '
  87.     LET image.address%=LONG{bitblock.address%}+address%
  88.     '
  89.     LET width%=WORD{bitblock.address%+4}*8
  90.     LET height%=WORD{bitblock.address%+6}
  91.     '
  92.     PRINT "Die Datei enthält ein Image."
  93.     PRINT
  94.     PRINT "Der Objektblock liegt an Adresse ";objectblock.address%
  95.     PRINT "Der Bitblock liegt an Adresse ";bitblock.address%
  96.     PRINT
  97.     PRINT "Das Image liegt an Adresse ";image.address%
  98.     PRINT
  99.     PRINT "Breite: ";width%
  100.     PRINT "Höhe: ";height%
  101.     '
  102.   ELSE
  103.     PRINT "Die Datei ist im IconEdi-Format, enthält aber weder Icon noch Image !!"
  104.   ENDIF
  105.   '
  106. ELSE
  107.   '
  108.   PRINT "Kein IconEdi-Format !!"
  109.   '
  110.   GOSUB ende
  111.   '
  112. ENDIF
  113. '
  114. ' ########################################################################################
  115. ' ##                                    Schreiben                                       ##
  116. ' ########################################################################################
  117. '
  118. '  Die Definition:
  119. '  $00    char icon_magic[4];    /* enthält "ICON"; $49434F4E */
  120. '  $04    int icon_version;      /* Versionsnummer, wie beim TOS; Start bei
  121. '                                     $0000 (=so wie hier vorgestellt) */
  122. '  $06    int icon_headerlength; /* Länge des Headers in Words, Standard : 6 */
  123. '  $08    int *objectblock;      /* Zeiger auf den Objektblock */
  124. '
  125. ' Pufferlänge bestimmen:
  126. '
  127. LET length.of.data%=DIV(width%,8)*height%   ! Länge der Daten (Maske bzw. Daten bzw. Image)
  128. '                                                                                 in Bytes
  129. IF object.type%=31                      ! Icon
  130.   LET length%=12+24+36+(length.of.data%*2)+(LEN(CHAR{text.address%})+1)
  131.   '           12: Header IconEdi-Format
  132.   '              24: Objektblock
  133.   '                 36: Iconblock
  134.   '                    (length.of.data%*2): Länge der Daten und Maske (in Bytes)
  135.   '                                        (LEN......+1): Länge des Textes inkl. Nullbyte
  136. ELSE
  137.   LET length%=12+24+14+length.of.data%
  138.   '           12: Header IconEdi-Format
  139.   '              24: Objektblock
  140.   '                 14: Bitblock
  141.   '                    length.of.data%: Länge des Images (in Bytes)
  142. ENDIF
  143. '
  144. address2%=MALLOC(length%)                ! Speicher allozieren
  145. '
  146. ' Header setzen:
  147. LONG{address2%}=&H49434F4E               ! "ICON"
  148. WORD{address2%+4}=0                      ! icon_version
  149. WORD{address2%+6}=6                      ! icon_headerlength
  150. LONG{address2%+8}=12                     ! *objectblock
  151. '
  152. IF object.type%=31                       ! Icon
  153.   '
  154.   ' Objektblock setzen:
  155.   BMOVE objectblock.address%,address2%+12,22   ! erstmal den alten kopieren und ...
  156.   ' ... dann die nötigen Werte ändern:
  157.   WORD{address2%+12}=0                   ! ob_next
  158.   WORD{address2%+14}=65535               ! ob_head
  159.   WORD{address2%+16}=65535               ! ob_tail
  160.   WORD{address2%+18}=31                  ! ob_type
  161.   ' ob_flags bleiben unverändert
  162.   ' ob_state bleibt unverändert
  163.   LONG{address2%+24}=36                  ! ob_spec
  164.   ' ob_x bleibt unverändert
  165.   ' ob_y bleibt unverändert
  166.   ' ob_width bleibt unverändert
  167.   ' ob_height bleibt unverändert
  168.   '
  169.   ' Iconblock setzen:
  170.   BMOVE iconblock.address%,address2%+36,36     ! erstmal den alten kopieren und ...
  171.   ' ... dann die nötigen Werte ändern:
  172.   LONG{address2%+36}=72                      ! ib_pmask
  173.   LONG{address2%+40}=72+length.of.data%      ! ib_pdata
  174.   LONG{address2%+44}=72+2*length.of.data%    ! ib_ptext
  175.   ' char bleibt unverändert
  176.   ' xchar bleibt unverändert
  177.   ' ychar bleibt unverändert
  178.   ' xicon bleibt unverändert
  179.   ' yicon bleibt unverändert
  180.   ' wicon bleibt unverändert
  181.   ' hicon bleibt unverändert
  182.   ' xtext bleibt unverändert
  183.   ' ytext bleibt unverändert
  184.   WORD{address2%+66}=6*LEN(CHAR{text.address%})  ! ib_wtext
  185.   WORD{address2%+68}=8                           ! ib_htext
  186.   WORD{address2%+70}=0                           ! ib_rsvd
  187.   '
  188.   ' Maske kopieren:
  189.   BMOVE mask.address%,address2%+72,length.of.data%
  190.   ' Daten kopieren:
  191.   BMOVE data.address%,address2%+72+length.of.data%,length.of.data%
  192.   ' Text kopieren:
  193.   CHAR{address2%+72+2*length.of.data%}=CHAR{text.address%}
  194.   '
  195. ELSE IF object.type%=23                   ! Image
  196.   '
  197.   ' Objektblock setzen:
  198.   BMOVE objectblock.address%,address2%+12,22   ! erstmal den alten kopieren und ...
  199.   ' ... dann die nötigen Werte ändern:
  200.   WORD{address2%+12}=0                   ! ob_next
  201.   WORD{address2%+14}=65535               ! ob_head
  202.   WORD{address2%+16}=65535               ! ob_tail
  203.   WORD{address2%+18}=23                  ! ob_type
  204.   ' ob_flags bleiben unverändert
  205.   ' ob_state bleibt unverändert
  206.   LONG{address2%+24}=36                  ! ob_spec
  207.   ' ob_x bleibt unverändert
  208.   ' ob_y bleibt unverändert
  209.   ' ob_width bleibt unverändert
  210.   ' ob_height bleibt unverändert
  211.   '
  212.   ' Bitblock setzen:
  213.   BMOVE bitblock.address%,address2%+36,14   ! erstmal den alten kopieren und ...
  214.   ' ... dann die nötigen Werte ändern:
  215.   LONG{address2%+36}=50                     ! bi_pdata
  216.   WORD{address2%+40}=DIV(width%,8)          ! Breite in Bytes
  217.   WORD{address2%+42}=height%                ! Höhe in Pixeln
  218.   ' bi_x bleibt unverändert
  219.   ' bi_y bleibt unverändert
  220.   ' bi_color bleibt unverändert
  221.   '
  222.   ' Image kopieren:
  223.   BMOVE image.address%,address2%+50,length.of.data%
  224.   '
  225. ENDIF
  226. '
  227. BSAVE file$,address2%,length%
  228. '
  229. GOSUB ende
  230. '
  231. PROCEDURE ende
  232.   IF address2%>0
  233.     VOID MFREE(address2%)
  234.   ENDIF
  235.   IF address%>0
  236.     VOID MFREE(address%)
  237.   ENDIF
  238.   '
  239.   RESERVE
  240.   '
  241.   END
  242.   '
  243. RETURN
  244.